CORE page# 0001 next
2: COMMENT ⊗   VALID 00033 PAGES
3: C REC  PAGE   DESCRIPTION
4: C00001 00001
5: C00004 00002    CORE ROUTINES FOR SWAPPING SYSTEM. 4 AUG 67 ↔ BEGIN CORE
6: C00007 00003    CORINI  INITIALIZE CORE TABLES
7: C00010 00004    CORE UUO
8: C00017 00005    SHUFFLER   CHKSHF
9: C00026 00006    ANYACT  ROUTINE TO TEST FOR ANY ACTIVE DEVICES
10: C00034 00007    CORE0
11: C00038 00008    ENTER HERE FROM CORE UUO OR RUN COMMAND WHEN IT REASSIGNS
12: C00043 00009    BAKOLD:
13: C00045 00010    MOVE OLD CORE TO NEW AREA
14: C00051 00011    DIDDLE
15: C00055 00012    CSTAT, STAPUT, STAPTT           STATISTICS SERVICE
16: C00058 00013    HOLSRC  
17: C00061 00014    CORCHK AND CORTCK  -- CHECK CORTAL AGAINST CORTAB AND CHECK CORTAB AGAINST WORLD
18: C00066 00015    CORSTG          ROUTINE TO SET AND CLEAR CORE USE TABLE
19: C00069 00016    CLRJOB
20: C00071 00017    GETPR
21: C00074 00018    RELOCA
22: C00079 00019    LOCK AND UNLOCK UUOS.
23: C00089 00020    FREE STORAGE    AND OTHER POLITICAL PRISONERS
24: C00090 00021    $       INITIALIZE FREE STORAGE
25: C00097 00022    $       FSGET:  GET FREE STORAGE AT ANY LEVEL.
26: C00108 00023    SWIPE 1K FROM AVAILABLE USER SPACE.
27: C00113 00024    $FSCLK: CLOCK LEVEL (CHANNEL 7) ROUTINES TO KEEP FREE STORAGE HAPPY!
28: C00118 00025    $       FSGIVE: RETURN FREE STORAGE TO SYSTEM.
29: C00128 00026    GET FREE STORAGE AT UUO LEVEL.
30: C00129 00027     ROUTINES TO GET AND RELEASE THE PDL AT UUO LEVEL ONLY. - GETPDL
31: C00133 00028    SPARE LIST HANDLER FOR DPYSER & TTYSER
32: C00136 00029    VERSION OF FSGET TO USE SPARE LIST
33: C00139 00030    ARRRGH! PI LEVEL AND NO FAILURE POSSIBLE! HERE WE CURL UP AND DIE
34: C00140 00031    VERSION OF FSGIVE TO THINK ABOUT PUTTING RETURNED BLOCK INTO SPARE LIST
35: C00142 00032    YES FANS, IT'S THE INFAMOUS RELEX, FORMERLY SCATTERED THROUGH TTYSER & DPYSER
36: C00145 00033    BEND CORE
37: C00146 ENDMK
38: C⊗;
    CORE page# 0002 next  prev
40: SUBTTL  CORE ROUTINES FOR SWAPPING SYSTEM. 4 AUG 67 ↔ BEGIN CORE
41: 
42: COMMENT $
43:         REVISED, MAY 1972 BY REG
44: 
45:         CORE IS ALLOCATED ON A 1K BLOCK BASIS.  A TABLE OF 257  9-BIT
46: BYTES  (CORTAB)  IS  KEPT.  EACH  BYTE  CORRESPONDS  TO A 1K BLOCK OF
47: ADDRESSABLE MEMORY (EXCEPT THE LAST WHICH IS ALWAYS NON-EXISTANT).  A
48: BYTE IS MARKED WITH THE FOLLOWING CODES:
49: 
50:         0       BLOCK IS AVAILABLE.
51:         1-77    BLOCK IS IN USE BY THE JOB NAMED IN THIS CODE
52:         101     BLOCK IS OCCUPIED BY THE SYSTEM
53:         103     BLOCK DOES NOT EXIST.
54:         105     BLOCK IS IN USE BY SYSTEM FREE STORAGE.
55: 
56:         WHEN THE SYSTEM IS LOADED OR  INITIALIZED,  CORINI  SETS  THE
57: CORTAB  TABLE TO REFLECT BLOCKS IN USE BY THE SYSTEM AND NON-EXISTANT
58: BLOCKS.  CORINI ALSO SETS  RMEMSIZ,  THE  SIZE  OF  PHYSICAL  MEMORY,
59: MEMSIZ,  THE  BOTTOM OF FREE STORAGE, AND LOCATION 37, SYSTEM JOBREL.
60: CORINI ALSO MAKES TWO BYTE POINTERS, CORLST IS  A  POINTER  PAST  THE
61: FIRST  NON-EX  BLOCK IN CORTAB; CORE2P IS A POINTER TO THE LAST BLOCK
62: USED  BY  SYSTEM  CODE.  CORTAL  IS  SET TO THE NUMBER OF FREE BLOCKS
63: AVAILABLE.
64: 
65:         CORE1  ASSIGNS  CORE TO A JOB, IF POSSIBLE, SETS THE USE CODE
66: IN CORTAB, AND MOVES THE JOB IF THIS ASSIGNMENT  IS  AT  A  DIFFERENT
67: PLACE THAN THE OLD.
68: 
69: THE TABLE, JBTADR, IS ALSO UPDATED BY THE CORE ROUTINES.
70:         JBTADR CONTAINS: PROTECTION,,RELOCATION OF A JOB.
71:         JBTADR  IS  MODIFIED  IF  CORE  FOR  CURRENT JOB THE HARDWARE
72: PROTECTION/RELOCATION REGISTER IS RESET IF THIS IS  THE  CURENT  JOB.
73: ALSO, JOBREL IN USER'S JOB DATA AREA IS ALWAYS UPDATED.
74: 
75: $
76: 
77: ;LIST OF GLOBALS AFFECTED:
78: ;JBTADR,CORTAL,CORTAB,HOLEF,SHFWAT,JOBADR
79: 
80: ;ACS USED(BESIDES TAC,TAC1,JDAT,IOS,DEVDAT,AND P)
81: BLK←AC1         ;HIGHEST REL. ADR. IN USER AREA
82: LOC←DSER        ;ABS. LOC. OF FIRST BLOCK IN USER AREA
    CORE page# 0003 next  prev
84: ;CORINI INITIALIZE CORE TABLES
85: ;REG THIS PAGE. 1972: 22 FEB, 15 APRIL, 28 APRIL.
86: 
87: COREP:  POINT   9,CORTAB
88:         POINT   9,CORTAB,8
89:         POINT   9,CORTAB,17
90:         POINT   9,CORTAB,26
91: ↑CORINI:
92:         MOVE    TAC,[XWD CORBEG,CORBEG+1]
93:         SETZM   CORBEG
94:         BLT     TAC,COREND
95: 
96:         SETZM   LOCKNO          ;NO JOB IS ATTEMPTING TO LOCK
97:         MOVE    TAC,SYSTOP
98:         MOVEM   TAC,LOKTOP      ;TOP OF LOCKED CORE IS SAME AS SYSTEM TOP.
99: 
100:         MOVE    TEM,COREP       ;BYTE POINTER TO CORTAB
101:         MOVEI   TAC,CORBLK      ; =256, MAXIMUM MEM SIZE
102:         CONO    APR,NXM         ;SHUT OFF NXM FLAG
103:         TDZA    TAC1,TAC1       ;BEGIN ZERO AND SKIP INCREMENT
104: CORI1:  ADDI    TAC1,2000       ;INCREMENT ADDRESS
105:         HLLZ    DAT,(TAC1)      ;REFERENCE MEMORY - ZERO RIGHT SIDE OF DAT
106:         CAMGE   TAC1,SYSSIZ     ;SKIP IF ADDRESS IN SYSTEM
107:         TROA    DAT,2           ;IN SYSTEM CODE WILL BE 103
108:         CONSZ   APR,NXM         ;SKIP UNLESS NXM
109:         TRCA    DAT,103         ;NXM CODE IS 103, IF SYSTEM, SET TO 101
110:         AOS     CORTAL          ;THIS BLOCK OF CORE IS AVAILABLE.
111:         IDPB    DAT,TEM         ;MARK THIS BLOCK IN CORTAB
112:         TRNE    DAT,2           ;SKIP IF NO NXM
113:         JRST    CORI2           ;NXM. QUIT NOW.
114:         TROE    DAT,103         ;SET NXM CODE, SKIP IF BEYOND SYSTEM
115:         MOVEM   TEM,CORE2P      ;SAVE CORE2P
116:         SOJG    TAC,CORI1       ;LOOP IF STILL INSIDE POSSIBLE MEMORY
117:         ADDI    TAC1,2000       ;FULL HOUSE.
118:         IDPB    DAT,TEM
119: CORI2:  MOVEM   TAC1,RMEMSIZ    ;SAVE FIRST PHYSICAL NON-EX ADDRESS 
120:         MOVEM   TAC1,MEMSIZ     ;SETUP LOWEST ADDRESS IN FREE STORAGE
121:         SUBI    TAC1,1          ;DECREMENT TO MAKE SYSTEM JOBREL
122:         MOVEM   TAC1,37         ;SAVE SYSTEM JOBREL FOR EXEC DDT AND UEDDT
123:         IBP     TEM             ;INCREMENT TO POINT TO 2ND NONEX DATA IN CORTAB
124:         MOVEM   TEM,CORLST      ;SAVE AS POINTER PAST ALL REAL MEMORY,
125: IFN FTSWAP,<
126:         MOVE    TAC,CORTAL      ;GET SIZE OF USER CORE
127:         LSH     TAC,=10         ;TURN K INTO WORDS
128:         MOVEM   TAC,CORMAX      ;SAVE AS MAX SIZE OF USER CORE
129:         MOVEI   TAC,%SWPL
130:         MOVEM   TAC,SWAPLI      ;SET SYSTEM SWAPLIMIT.
131: >
132:         POPJ    P,
    CORE page# 0004 next  prev
134: SUBTTL  CORE UUO
135: 
136: COMMENT $
137: CALL BY:
138:         MOVEI   AC,<HIGHEST RELATIVE ADDRESS DESIRED>
139:         CALL    AC,['CORE  ']   OR      CALLI   AC,11
140:         <ERROR RETURN: CAN'T ASSIGN CORE>
141:         OK RETURN.  JOB MAY HAVE BEEN SHUFFLED OR SWAPPED.
142: 
143: THE NUMBER OF 1K BLOCKS THAT A JOB MAY HAVE IS RETURNED IN AC.
144: IF AC CONTAINS 0 THEN DO NOT CHANGE CORE ALLOCATION, JUST
145: RETURN NUMBER OF AVAILABLE BLOCKS IN AC (ERROR RETURN).
146: 
147: $
148: 
149: 
150: ↑CORUUO:
151:         JUMPE   TAC,ZERCOR              ;IS ARGUMENT ZERO?
152:         AOS     (P)                     ;ASSUME SUCCESS RETURN.
153:         PUSHJ   P,UNLOCK                ;CORE UUO WILL FORCE UNLOCK.
154:         PUSHJ   P,UCORE                 ;DO IT!!
155:         SOS     (P)                     ;BAD ASSUMPTION. FAILURE RETURN.
156: ZERCOR: MOVE    TAC,CORMAX              ;GET CURRENT FREE SPACE.
157:         CAMLE   TAC,SWAPLIMIT           ;MORE THERE THAN HE CAN HAVE?
158:         MOVE    TAC,SWAPLIMIT           ;YES. TELL HIM MAX WE'LL ALLOW.
159:         ASH     TAC,-12                 ;CONVERT TO BLOCKS!
160:         JRST    STOTAC                  ;RETURN CORMAX TO USER
161: 
162: ↑UCORE: IORI    TAC,1777                ;ROUND UP TO A 1K BOUNDARY.
163:         MOVE    TAC1,JBTSTS(J)          ;GET JOB STATUS
164:         TLNN    TAC1,JSEG               ;AND SKIP IF THIS IS AN UPPER.
165:         JRST    CORCS2                  ;NOT AN UPPER.
166:         PUSH    P,J                     ;SAVE UPPER'S JOB NUMBER.
167:         MOVEI   J,JOBN-1                ;LOOK THRU ALL JOBS...
168: CORCSO: LDB     TAC1,PSEGN              ;DOES THIS GUY POINT TO ME?
169:         CAME    TAC1,(P)                ;SKIP IF A USER OF THIS UPPER.
170:         JRST    CORCSL                  ;NO.
171:         MOVE    TAC1,J                  ;TAC ← JOB NUMBER OF THIS LOWER.
172:         PUSHJ   P,CORSGT                ;GET THE SIZE OF THIS LOWER.
173:         ADDI    TAC1,1(TAC)             ;LOWER SIZE + MY REQUEST SIZE.
174: CORCS3: CAMG    TAC1,CORMAX             ;TOO BIG?
175:         JRST    CORCSL                  ;NOT TOO BIG. CHECK OTHER LOWERS.
176:         POP     P,J                     ;THIS LOWER AND ME WONT FIT
177:         POPJ    P,                      ;GIVE THE ERROR RETURN.
178: 
179: CORCSL: SOJG    J,CORCSO                ;CONTINUE SCAN THRU ALL JOBS.
180:         POP     P,J                     ;RESTORE J
181:         JRST    CORXOK                  ;SO FAR, SO GOOD.
182: 
183: CORCS2: LDB     TAC1,PSEGN              ;NOT A SEGMENT. HAS IT AN UPPER?
184:         SKIPE   DAT,TAC1                ;SKIP IF NO UPPER. GET NUMBER IN DAT
185:         PUSHJ   P,CORSGT                ;GET SIZE OF UPPER IN TAC1.
186:         ADDI    TAC1,1(TAC)             ;UPPER'S SIZE + THIS REQUEST.
187:         CAMLE   TAC1,CORMAX             ;DOES IT FIT?
188:         POPJ    P,                      ;NOPE.
189: CORXOK: PUSH    P,TAC                   ;SAVE SIZE WE WANT TO BE.
190:         PUSH    P,UUO                   ;SAVE
191:         PUSH    P,J                     ;SAVE J IF THIS IS A SEGMENT.
192:         PUSHJ   P,IOWAIT                ;WAIT FOR ALL IO TO STOP.
193:         JRST    .+2
194: CORYOK: PUSHJ   P,WSCHED
195:         PUSHJ   P,ANYACT                ;MAKE SURE WE CAN BE MOVED.
196:         JRST    CORYOK                  ;NO. WAIT UNTIL WE CAN.
197:         POP     P,J                     ;RESTORE J
198:         POP     P,UUO
199:         POP     P,TAC                   ;HIGHEST REL. LOC. DESIRED
200:         AOS     (P)                     ;SET SKIP RETURN.
201: CORUU1: SKIPE   PROG,JBTADR(J)          ;PICK UP PROG 
202:                                         ;COULD HAVE BEEN CLOBBERED IF IT'S AN UPPER.
203:         JRST    CORUU5                  ;JUMP IF WE HAVE CORE ALREADY.
204:         PUSHJ   P,CORGET                ;NO: DON'T RELEASE PREVIOUS CORE
205:         SOS     (P)                     ;FAILURE RETURN.
206:         JRST    CORUU3
207: 
208: CORUU5: PUSHJ   P,CORE1                 ;TRY TO REASSIGN CORE
209:         SOS     (P)                     ;NOT AVAILABLE, ERROR RETURN
210: 
211: CORUU3:
212: IFN FTSWAP,<
213:         PUSHJ   P,WSCHED                ;CALL SCHEDULER TO STOP JOB
214:                                         ;IN CASE CORE NOW ON DISK.
215: >
216:         MOVE    TAC1,JBTSTS(J)
217:         TLNN    TAC1,JSEG               ;SKIP IF THIS IS AN UPPER.
218:         JRST    SPWCNT                  ;CONTINUE SPACEWAR FOR THIS JOB
219:         JRST    NOTSH9                  ;CONTINUE SPACEWAR FOR ALL LOWERS.
220: 
221: ;RUNCOR IS CALLED FROM SAVGET, (NOT CORUUO) (SINCE IT DOESN'T STORE ANYTHING?)
222: 
223: ↑RUNCOR:
224:         AOS     (P)                     ;ASSUME SUCCESS.
225:         PUSHJ   P,CORE1                 ;TRY TO ASSIGN CORE.
226:         SOS     (P)                     ;WE SET FAILURE RETURN
227:         JRST    WSCHED                  ;HOLD UP IF CORE IS NOW ON DISK.
228: 
229: ↑CORSGT:                                ;GET SIZE OF THIS JOB, WHETHER IN OR OUT.
230:         PUSH    P,TAC                   ;SAVE TAC
231:         MOVE    TAC,JBTSTS(TAC1)        ;GET JOB STATUS
232:         TLNN    TAC,SWP                 ;SKIP IF ON DISK,
233:         JRST    CORSG1                  ;HE'S IN CORE.
234:         LDB     TAC1,[POINT 9,JBTSWP(TAC1),35]  ;GET THE SIZE OF THE IMAGE
235:         LSH     TAC1,=10                ;SHIFT TO MAKE WORDS.
236:         JRST    TPOPJ                   ;RESTORE TAC AND RETURN.
237: CORSG1: HLRZ    TAC1,JBTADR(TAC1)       ;GET THE PROTECTION SIZE
238:         AOJA    TAC1,TPOPJ              ;INCREMENT PROT, POP TAC AND RETURN
    CORE page# 0005 next  prev
240: SUBTTL  SHUFFLER   CHKSHF
241: 
242: ;ROUTINE TO CHECK JOBS TO SEE IF ANY JOB CAN BE SHUFFLED
243: ;CALLED FROM THE SWAPPER WHEN THERE IS ENOUGH FREE CORE
244: ;TO FIT A JOB, BUT THERE IS NO SINGLE HOLE BIG ENOUGH.
245: ;
246: ;A JOB MUST HAVE ALL DEVICES INACTIVE (SINCE SOME
247: ;OF THEM USE ABSOLUTE ADDRESSES) BEFORE IT CAN BE MOVED.
248: ;IF DEVICES ARE ACTIVE, JOB WILL BE STOPPED SO THAT IO WILL
249: ;CEASE SOON SO JOB CAN BE SHUFFLED
250: ;ALL DEVICES LOOK AT SHF BIT IN JBTSTS (ADVBFF OR ADVBFE)
251: ;TO SEE IF MONITOR IS WAITING TO SHUFFLE JOB
252: 
253: ;THIS VERSION OF THE CORE SHUFFLER WORKS AS FOLLOWS:
254: ;EVERY CLOCK TICK FOR WHICH ALL JOBS ARE SHUFFLEABLE (NOT COUNTING ACTIVE
255: ;IO DEVICES), THE JOB IMMEDIATELY ABOVE THE LOWEST HOLE
256: ;(IF ANY) WILL BE MOVED DOWN INTO HOLE.  THE HOLEF IS SET NON-ZERO
257: ;TO THE ADDRESS OF JOB IMMEDIATELY ABOVE THE LOWEST
258: ;HOLE (0 IF NONE), EVERY TIME CORE IS REASSIGNED.
259: 
260: ↑CHKSHF:
261:         HGMAC   (26)
262:         SKIPE   J,SHFWAT        ;DID WE STOP A JOB TO WAIT FOR IO INACTIVE?
263:         JRST    SHFLOP          ;YES, SEE IF IO HAS STOPPED YET
264:         SKIPN   TAC,HOLEF       ;NO, DOES CORE HAVE A HOLE IN IT?
265:         JRST    CHKSHX
266: CHKSHZ: CAML    TAC,MEMSIZ
267:         JRST    CHKERR
268:         PUSHJ   P,CORGB1        ;MAKE A BYTE POINTER FROM HOLEF
269:         ILDB    J,TAC           ;GET A USE BYTE
270:         CAIGE   J,JOBN          ;VALIDITY CHECK-SKIP IF ILLEGAL
271:         JUMPG   J,SHFLOA        ;FOUND ONE?
272: SHFLOB: PUSHACS
273:         PUSHJ   P,DISDATE
274:         PUSHJ   P,DISMES
275:         ASCIZ   /HOLEF = /
276:         MOVE    TAC,HOLEF
277:         PUSHJ   P,DISLOC
278:         PUSHJ   P,DISMES
279:         ASCIZ   /  BUT NO HOLE PRESENT. CORTAB = /
280:         MOVE    LOC,HOLEF
281:         PUSHJ   P,CORGBP        ;GET A BYTE POINTER.
282:         ILDB    J,TAC           ;GET THE BYTE.
283:         CAIL    J,JOBN
284:         JRST    HOLHLP
285:         PUSH    P,J
286:         PUSHJ   P,DISJOB        ;PRINT JOB NAME & NUMBER.
287:         PUSHJ   P,DISCRLF
288:         POP     P,TAC
289:         HRRZ    TAC1,JBTADR(TAC)        ;TAC1←BOTTOM OF JOB
290:         HLRZ    TAC,JBTADR(TAC)
291:         ADDI    TAC,(TAC1)              ;TAC← TOP OF JOB.
292:         CAMG    TAC1,HOLEF      ;SKIP IF HOLEF BELOW THE BOTTOM
293:         CAMG    TAC,HOLEF       ;SKIP IF HOLEF INSIDE THIS IMAGE.
294:         JRST    .+2             ;WE CAN FIX THIS?
295:         JRST    HOLHLP          ;WE NEED HELP.
296:         MOVE    LOC,HOLEF
297:         PUSHJ   P,CORGBP
298:         MOVEI   TAC1,0
299:         IDPB    TAC1,TAC
300:         JRST    HOLFIX
301: 
302: HOLHLP: PUSHJ   P,DISMES
303:         ASCIZ   /I CAN'T FIX IT.
304: /
305:         PUSHJ   P,DISFLU
306:         PUSHJ   P,DDTCAL
307: HOLFIX: POPACS
308:         JRST    CHKSHX
309: 
310: CHKERR: PUSHACS
311:         PUSHJ   P,DISMES
312:         ASCIZ   /ππHOLEF OUT OF BOUNDS
313: /
314:         POPACS
315:         SETZM   HOLEF
316: CHKSHX: SOS     (P)             ;SET UP SWAPPER'S PARAMETERS AGAIN
317:         PSYNC   CORCSC
318:         JRST    DIDLE4
319: 
320: SHFLOA: HRRZ    TAC,JBTADR(J)
321:         CAME    TAC,HOLEF
322:         JRST    SHFLOB          ;LOSER!
323: 
324: ;THIS CODE DECIDES WHETHER TO SWAP INSTEAD OF SHUFFLE
325:         SKIPN   JBTST2(J)       ;IS THERE SPACEWAR ACTIVE FOR THIS JOB?
326:         SKIPG   TAC,FIT         ;NO.  AND SOMEONE BEING FITTED IN?
327:         JRST    SHFLOP          ;SPACEWAR ACTIVE OR NO ONE BEING FITTED
328:         MOVE    TAC,JBTPRI(TAC) ;PRIORITY OF JOB BEING FITTED.
329:         CAMG    TAC,JBTPRI(J)   ;SKIP IF SHUFFLED JOB HAS LOW PRIORITY.
330:         JRST    SHFLOP          ;SHUFFLED JOB HAS HIGH PRIORITY, DON'T FORCE IT
331:         MOVE    TAC,SEGWAIT
332:         LDB     TAC,[POINT 6,JBTSTS(TAC),35]
333:         CAIN    TAC,(J)         ;IS THIS THE SEGMENT THAT SOMEONE IS WAITING FOR?
334:         JRST    SHFLOP          ;YES. DON'T SHOVE IT OUT!
335:         SKIPE   FORCE           ;IF FORCE IS SET THEN WE CAN'T MAKE US SWAP
336:         JRST    SHFLOZ          ;TELL PEOPLE THAT WE HAVE LOST.
337: SHFLOX: JRST    SHFLOP          ;CLOBBER THIS TO JFCL TO MAKE IT SWAP INSTEAD
338: 
339:         MOVSI   TAC,SWP
340:         IORM    TAC,JBTSTS(J)   ;ANNOUNCE THAT WE ARE SWAPPING THIS GUY.
341:         MOVEM   J,FORCE
342:         POPJ    P,              ;TELL THEM WE WANT TO SWAP THIS USER
343: 
344: SHFLOZ: PUSH    P,J             ;THIS MESSAGE IS FOR INFORMATION ONLY!
345:         PUSHJ   P,DISMES
346:         ASCIZ   /[FORCE SET AT SHFLOZ]
347: /
348:         POP     P,J
349: 
350: SHFLOP: JUMPL   J,CPOPJ         ;JUMP IF A JOB IS ALREADY MOVING.
351:         SKIPN   PROG,JBTADR(J)  ;SETUP PROG FOR CALL
352:         JRST    NOTSH1          ;NO CORE. HE CAN'T BE SHUFFLED, SO CLEAR SHFWAT
353: IFN JDMPRG,<
354:         MOVE    JDAT,JBTDAT(J)  ;JOB DATA AREA
355: >
356:         HLRZ    TAC,PROG        ;REASSIGN SAME AMOUNT OF CORE.
357:         PUSHJ   P,SHFCOR        ;IN A LOWER POSITION IN CORE
358:         JRST    NOTSHF          ;CANNOT ONLY IF IO IS ACTIVE
359: 
360: IFN FTSHF1K,<
361:         SKIPE   SHFJOB          ;IF FINISHED, CLEAN UP SHF BIT AND OTHER CELLS
362:         POPJ    P,              ;OTHERWISE, RETURN, LETTING CLOCK DO THE MOVING
363: >
364:         JRST    NOTSH1          ;FINISHED SHUFFLING, CLEAN UP
365: 
366: NOTSHF: SKIPN   HOLEF           ;JOB CAN'T BE MOVED.  STILL ACTIVE IO.
367:         JRST    NOTSH1          ;HOLE ISN'T THERE ANYMORE?
368: IFN FTSWAP,<
369:         MOVM    TAC,FORCE
370:         CAME    J,FIT
371:         CAMN    J,TAC
372:         JRST    NOTSH1          ;IF THIS JOB IS BEING SWAPPED, DON'T SHUFFLE
373: >
374:         MOVEM   J,SHFWAT        ;SET SHUFFLE WAIT FLAG WITH JOB NO.
375:         MOVSI   TAC,SHF         ;SET SHF WAIT BIT IN JOB STATUS WORD
376:         SKIPN   JBTST2(J)       ;IF SPW RUNNING, LET HIM RUN TOO
377:         IORM    TAC,JBTSTS(J)   ;SO JOB WILL NOT BE RUN
378:         POPJ    P,              ;AND IO WILL STOP SOON
379: 
380: ↑NOTSH1:                        ;HERE WHEN JOB FINISHES MOVING
381:         PSYNC   CORCSC
382:         SETZM   SHFWAT          ;JOB SHUFFLED, CLEAR FLAG
383: IFN FTSHF1K,<
384:         SETZM   SHFTAC          ;CLEAR SHUFFLE FLAGS WHEN DONE
385:         SETZM   SHFEND
386:         SETZM   SHFJOB
387: >
388:         MOVSI   TAC,SHF         ;CLEAR SHUFFLE WAIT BIT IN CASE IT WAS ON
389:         ANDCAB  TAC,JBTSTS(J)
390:         SKIPN   JBTADR(J)
391:         JRST    NOTSH4          ;IF WE DON'T HAVE CORE, DON'T CONTINUE SPACEWAR
392:         TLNE    TAC,JSEG
393:         JRST    NOTSH6          ;YES.
394:         PUSHJ   P,SPWCNT        ;THIS IS A LOWER, CONTINUE SPACEWAR FOR HIM
395:         JRST    NOTSH4
396:  
397: NOTSH9: MOVEI   TAC1,(J)        ;THIS IS AN UPPER, FIND OUR LOWERS.
398:                                 ;(CALLED FROM CORE2 UUO, AND FROM NOTSH6)
399:         MOVEI   J,JOBN-1        ;AND CONTINUE THEIR SPACEWAR.
400: NOTSH3: MOVE    TAC,JBTSTS(J)
401:         ANDI    TAC,77          ;PSEGN BETTER POINT TO BITS 30-35.
402:         CAIN    TAC,(TAC1)      ;IS THIS ONE OF MY LOWERS?
403:         PUSHJ   P,SPWCNT        ;YES. CONTINUE HIS SPACEWAR.
404:         SOJG    J,NOTSH3        ;LOOP LOOKING FOR ALL LOWER USERS OF THIS SEG.
405:         MOVEI   J,(TAC1)        ;RESTORE J.
406:         POPJ    P,
407: 
408: NOTSH6: PUSHJ   P,NOTSH9        ;CONTINUE SPACEWAR FOR LOWERS OF THIS UPPER.
409: NOTSH4:
410: 
411: IFN FTSHF1K,<
412:         SKIPN   SHFBLK          ;ANY CORE TO RETURN?
413:         JRST    NOTSH2          ;NO.
414:         HRRZ    LOC,SHFBLK
415:         HLRZ    BLK,SHFBLK
416:         SETZB   UCHN,SHFBLK
417:         PUSHJ   P,CORSTG        ;YES. RETURN IT.
418: >
419: 
420: NOTSH2: SOS     (P)             ;DIDLE SKIP RETURNS
421:         JRST    DIDLE4          ;RE-FORM CORE AVAIL PARAMS.
422: 
423: ↑SPWCNT:                        ;CONTINUE A SPW JOB
424:         SKIPN   JBTST2(J)       ;IS THERE A SPW JOB HERE??
425:         POPJ    P,              ;NO.
426:         PSYNC   SPWCSC
427:         MOVSI   TAC,SPWST1!SPWST2
428:         ANDCAM  TAC,JBTST2(J)
429:         XSYNC   SPWCSC
430:         POPJ    P,
    CORE page# 0006 next  prev
432: SUBTTL  ANYACT  ROUTINE TO TEST FOR ANY ACTIVE DEVICES
433: COMMENT  $
434: CALLING
435:         MOVE    J,JOB NUMBER
436:         MOVE    JDAT,ADDRESS OF JOB DATA AREA
437:         PUSHJ   P,ANYACT
438:         <HERE IF DEVICES ACTIVE>
439:         <HERE IF NO DEVICE IS ACTIVE, EXCEPT POSSIBLY TTY>
440: $
441: 
442: ↑ANYACT:
443:         MOVE    UCHN,JBTSTS(J)          ;GET JOB STATUS
444:         TLNN    UCHN,JSEG               ;SKIP IF THIS IS AN UPPER
445:         JRST    ANYAC3                  ;THIS IS A LOWER
446:         PUSH    P,PROG                  ;SAVE VITAL DATA.
447:         PUSH    P,J                     ;SAVE THIS JOB NUMBER.
448:         MOVEI   J,JOBN-1                ;SEARCH THRU ALL JOBS.
449: ANYAC1: LDB     UCHN,PSEGN              ;LOOKING FOR LOWERS THAT POINT HERE
450:         CAME    UCHN,(P)                ;DOES THIS POINT TO ME.
451: ANYA1A: SOJG    J,ANYAC1                ;NO. DECREMENT J AND LOOP
452:         JUMPLE  J,ANYAC2                ;JUMP IF WE HAVE EXHAUSTED THE LOOP
453:         MOVE    PROG,JBTADR(J)          ;YES. GET HIS ADDRESS
454:         PUSHJ   P,ANYAC3                ;CALL ROUTINE FOR A LOWER SEGMENT
455:         CAIA                            ;LOSE. CANT MOVE THIS LOWER
456:         JRST    ANYA1A                  ;THIS LOWER DOESN'T CARE IF WE MOVE
457:         POP     P,J
458:         POP     P,PROG
459:         POPJ    P,                      ;FAILURE RETURN
460: 
461: ANYAC2: POP     P,J                     ;RESTORE JOB NUMBER
462:         POP     P,PROG
463:         JRST    CPOPJ1                  ;SUCCESS RETURN.
464: 
465: ANYAC3: SKIPN   JBTADR(J)               ;ANY CORE THERE?
466:         JRST    CPOPJ1                  ;NO CORE MEANS NO IO ACTIVE.
467:         SKIPE   JBTGLU(J)               ;IS SOMEONE GLUEING HIM?
468:         POPJ    P,                      ;YES. FAKE ACTIVE DEVICE.
469:         MOVEI   UCHN,JOBJDA(JDAT)       ;ASSUME JOB IS NOT CURRENT JOB
470:         CAMN    J,JOB(PID)              ;IS IT CURRENT JOB?
471:         MOVEI   UCHN,USRJDA(PID)        ;YES. GET DATA FROM MONITOR.
472:         MOVEI   IOS,IOACT               ;IO DEVICE ACTIVE BIT
473:         SKIPL   AC2,JOBJMH(UCHN)        ;GET NO. OF USER IO CHANNELS IN USE
474:         CAILE   AC2,17                  ;IS HIGHEST CHANNEL LEGAL?
475:         JRST    ANY3                    ;SAVEGET IO ACTIVE  OR ILLEGAL CHANNEL.
476:         TLO     UCHN,AC2                ;SET TO ADD UCHN TO AC2
477:         MOVSI   TAC1,DVTTY              ;DEVICE IS A TTY BIT
478: ANY:    HRRZ    DDB,@UCHN               ;IS A DEVICE ASSIGNED TO THIS CHANNEL?
479:         JUMPE   DDB,ANY2                ;NO.
480:         CAIL    DDB,CHKBEG              ;CHECK ADDRESS. SKIP IF LOW CORE
481:         CAML    DDB,MEMSIZ              ;SKIP IF BELOW F.S. (NO NO)
482:         CAML    DDB,RMEMSIZ             ;BELOW REAL MEM? (REDUNDANT FOR LOW CORE)
483:         JRST    ANY7                    ;LOSING ADDRESS
484:         TDNN    IOS,DEVIOS(DDB)         ;YES, IS IT ACTIVE?
485: ANY2:   SOJGE   AC2,ANY                 ;NOT ACTIVE KEEP LOOKING
486:         JUMPL   AC2,ANY4A               ;JUMP IF FINISHED LOOKING
487:         TDNN    TAC1,DEVMOD(DDB)        ;NOT FINISHED, IS DEVICE TTY?
488:         POPJ    P,                      ;NOT TTY DEVICE ACTIVE. CANT MOVE THIS JOB
489:         JRST    ANY2                    ;DEVICE IS TTY.  LOOK AT OTHER DEVICES
490: 
491: ANY4A:  SKIPL UCHN,JBTIOP(J)
492:         JRST ANY4
493: ANY4BA: SKIPN DDB,(UCHN)                ;GET DDB POINTER (SKIP FLUSHED ONES)
494:         JRST ANY4C
495:         TDNE IOS,DEVIOS(DDB)            ;IOACT ON?
496:         TDNE TAC1,DEVMOD(DDB)           ;YES, TTY?
497:         CAIA                            ;YES (TTY) OR NO (IOACT)
498:         POPJ P,                         ;ACTIVE IO
499: ANY4C:  ADD UCHN,[1,,1]                 ;ADVANCE TO CHANNEL NUM
500:         AOBJN UCHN,ANY4BA               ;ADVANCE TO NEXT DDB AND TEST
501:         JRST ANY4
502: 
503: ANY7:   PUSHACS                         ;DDB ADDRESS IS OUT OF BOUNDS.
504:         PUSHJ   P,DISDATE
505:         PUSHJ   P,DISMES
506:         ASCIZ   /ANY7: ILLEGAL DDB ADDRESS = /
507:         HRRZ    TAC,DDB-17(P)           ;PICK UP ADDRESS
508:         PUSHJ   P,DISLOC                ;TYPE ADDRESS IN OCTAL
509:         PUSHJ   P,DISTAB
510:         MOVE    J,J-17(P)
511:         PUSHJ   P,DISJOB
512:         PUSHJ   P,DISMES
513:         ASCIZ   / USER IO CHANNEL /
514:         MOVE    TAC,AC2-17(P)
515:         PUSHJ   P,DISLOC
516:         PUSHJ   P,DISCRLF
517:         MOVE    J,J-17(P)
518: ;       PUSHJ   P,DATERR                ;FIX JOB DATA AREA.
519:         POPACS
520:         SETZM   @UCHN                   ;BLAST ILLEGAL DDB POINTER
521:         JRST    ANY2
522: 
523: ANYHCC: PUSHACS 
524:         PUSHJ   P,DISDAT
525:         PUSHJ   P,DISMES
526:         ASCIZ   /JOBHCU CLOBBERED AT ANYACT. /
527:         MOVE    J,J-17(P)
528:         PUSHJ   P,DISJOB
529:         PUSHJ   P,DISMES
530:         ASCIZ   /  JOBHCU = /
531:         MOVE    TAC,AC2-17(P)
532:         PUSHJ   P,DISOCT
533:         PUSHJ   P,DISCRLF
534:         MOVE    J,J-17(P)
535: ;       PUSHJ   P,DATERR                ;FIX JOB DATA AREA
536:         POPACS
537:         SETZM   JOBJMH(UCHN)            ;SET ONLY USER CHANNEL 0 IN USE.
538:         SETZM   (UCHN)                  ;CLEAR USER CHANNEL 0.
539:         JRST    CPOPJ1                  ;FAKE SUCCESS RETURN.
540: 
541: ANY3:   JUMPG   AC2,ANYHCC              ;JOBHCU IS CLOBBERED.
542:         HRRZ    AC2,AC2                 ;ADDRESS ONLY, PLEASE!
543:         CAIL    AC2,CHKBEG              ;SKIP IF IN SYSTEM LOW CORE.
544:         CAML    AC2,MEMSIZ              ;NO. MUST BE IN FREE STORAGE.
545:         CAML    AC2,RMEMSIZ             ;IF IN F.S.  MUST BE IN REAL MEM.
546:         JRST    ANYILM                  ;WE LOSE.
547: ANY3A:  TDNN    IOS,DEVIOS(AC2)         ;IS SAVEGET DEVICE STILL ACTIVE?
548:         AOS     (P)                     ;NO
549:         POPJ    P,                      ;YES
550: 
551: ANYILM: PUSHACS
552:         PUSHJ   P,DISDATE
553:         PUSHJ   P,DISMES
554:         ASCIZ   /ANYILM: SAVGET JOBCHU - ILLEGAL DDB ADDRESS.
555: /
556:         POPACS
557:         JRST CPOPJ1                     ; PRETEND SUCCESSFUL
558: 
559: ANY4:   SKIPE   JBTIIP(J)               ; INTERRUPT IN PROGRESS
560:         POPJ    P,                      ;YES. CAN'T MOVE ME.
561:         SKIPN   SP2GO(J)                ; IS A P2 SPACEWAR JOB RUNNING?
562:         SKIPE   SPWGO(J)                ; OR IS A P1 SPACEWAR JOB RUNNING?
563:         AOSA    (P)                     ;SPACEWAR ACTIVE. ASSUME SKIP RETURN!
564:         JRST    CPOPJ1                  ;WE CAN BE MOVED.
565: 
566:         PSYNC   SPWCSC
567:         MOVE    IOS,JBTST2(J)
568:         TLC     IOS,SPWST1!SPWST2
569:         TLCN    IOS,SPWST1!SPWST2
570:         JRST    ANY4B                   ;SPW SUSPENDED. GIVE SKIP RETURN.
571:         MOVSI   IOS,SPWSUS              ;NO. MARK IT FOR SUSPENSION
572:         TDNN    IOS,JBTST2(J)           ;SKIP IF SUSPENSION REQUEST SET ALREADY.
573:         IORM    IOS,JBTST2(J)           ;SET THE BIT THAT REQUESTS SPW SUSPENSION
574:         SOS     (P)                     ;NON-SKIP RETURN.
575: ANY4B:  XSYNC   SPWCSC
576:         POPJ    P,                      ;CANT MOVE HIM UNTIL HE'S SEEN SUSPENSION.
    CORE page# 0007 next  prev
578: SUBTTL  CORE0
579: ;CORE0 IS CALLED BY THE CORE MONITOR COMMAND AND THE CORE SHUFFLER
580: ;AND RUN COMMAND
581: ;CORE SHUFFLER AND RUN COMMAND
582: 
583: ;CALL:  MOVE TAC,HIGHEST LEGAL ADDRESSABLE LOC. DESIRED
584: ;       MOVE J,JOB NUMBER
585: ;       MOVE PROG,[XWD PROT.,RELOC.]=JBTADR(J)
586: ;       PUSHJ P,CORE0
587: ;       ERROR   ;EITHER JOB HAS ACTIVE IO
588:                 ;OR NOT ENOUGH CORE
589: ;       OK RETURN
590: ;JOB IS MOVED IF NECESSARY TO SATISFY REQUEST
591: ;PROG AND JDAT ARE SET TO NEW CORE ASSIGNMENT ON EITHER RETURN
592: ;0 MEANS NONE ASSIGNED
593: 
594: ;ENTER HERE FROM CORE CONSOLE COMMAND OR INITIAL CORE
595: ;ASSIGNMENT OF JUST A JOB DATA AREA FOR RUN COMMAND
596: ;IE ENTER WHEN DEVICES MAY BE ACTIVE OR JOB MAY HAVE NO PREVIOUS CORE
597: 
598: 
599: ↑CORE0:
600: IFE FTSWAP,<
601:         JUMPE   PROG,CORGET     ;IS JOB WITHOUT CORE IN MEMORY?
602: >
603: IFN FTSWAP,<
604:         CAML    TAC,SWAPLIMIT   ;IS HE BEING TOO GREEDY.
605:         POPJ    P,              ;FLUSH THE GREEDY BASTARD!      ;JS
606:         JUMPN   PROG,CORE0A     ;DOES JOB HAVE CORE IN MEMORY?
607:         MOVSI   TAC1,SWP        ;NO, DOES IT HAVE CORE ON DISK?
608:         CAMGE   TAC,CORMAX      ;WILL REQUEST FIT IN PHYSICAL CORE.
609:         TDNN    TAC1,JBTSTS(J)  ;YES, IS JOB ON DISK?
610:         JRST    CORGET          ;NO, TRY TO ASSIGN MEMORY IN CORE OR DISK.
611:         JUMPE   TAC,CORE0B      ;YES, IS HE REQUESTING ANY?
612:         LSH     TAC,-12         ;YES, CONVERT TO 1K BLOCKS
613:         AOSA    TAC
614: CORE0B: ANDCAM  TAC1,JBTSTS(J)  ;NO, CLEAR CORE ON DISK BIT.
615: ↑CORE0K:
616:         DPB     TAC,IMGIN       ;STORE NEW CORE IMAGE BLOCK SIZE
617: IFN FTSTAT,<
618:         PUSH P,TAC
619:         LSH TAC,6
620:         ANDI TAC,37700
621:         TRO TAC,CSZSTA
622:         PUSHJ P,STAPUT
623:         POP P,TAC
624: >;FTSTAT
625:         PUSH    P,DAT
626:         LDB     DAT,IMGOUT      ;SIZE ON DISC (1K BLOCKS)
627:         CAML    TAC,DAT         ;NEW SIZE LESS THAN AMOUNT ON DISC?
628:         JRST    CORE0C          ;NO, RETURN
629:         SETZM   SWPCNT          ;WAKE UP SWAPPER NEXT TICK
630:         DPB     TAC,IMGOUT      ;YES, REPLACE DISC SIZE
631:         SUB     DAT,TAC         ;AMOUNT OF DISC TO FREE (1K BLOCKS)
632:         LSH     TAC,CONVMD      ;CONVERT NEW SIZE TO DISC BLOCKS
633:         HLRZ    TAC1,JBTSWP(J)  ;COMPUTE DISC BLOCK NUMBER FOR
634:         ADD     TAC,TAC1        ;FIRST BLOCK TO FREE.
635:         PUSHJ   P,FXSAT         ;FREE THE DISC BLOCKS.
636: CORE0C: POP     P,DAT           ;RESTORE TTY OUTPUT BYTE POINTER
637:         JRST    CPOPJ1          ;AND SKIP RETURN
638: 
639: CORE0A:
640: >
641:         PUSHJ   P,ANYACT        ;NO,ANY ACTIVE DEVICE?
642:         POPJ    P,              ;YES, CANNOT ASSIGN CORE
643:                                 ;NO, FALL INTO CORE1
    CORE page# 0008 next  prev
645: ;ENTER HERE FROM CORE UUO OR RUN COMMAND WHEN IT REASSIGNS
646: ;PROPER AMOUNT OF CORE AFTER READING DIRECTORY
647: ;JOB MUST ALREADY HAVE CORE AND NO ACTIVE DEVICES
648: ;FIRST OLD CORE IS RETURNED TO SYSTEM
649: ;THEN NEW REQUEST IS ATTEMPTED TO BE SATISFIED IN LOWEST
650: ;POSITION POSSIBLE.  THUS CORE TENDS TO BE PACKED
651: ;IF NEW REQUEST CANNOT BE GRANTED, OLD AMOUNT IS RETAINED
652: 
653: ↑CORE1: CAML    TAC,SWAPLIMIT   ;CAN HE HAVE THIS MUCH?
654:         POPJ    P,              ;NO
655:         NOSCHEDULE              ;PREVENT SCHEDULING
656:         PSYNC   CORCSC
657:         MOVE    LOC,JBTSTS(J)
658:         TRNE    LOC,JLOCK
659:         PUSHJ   P,UNLOCK        ;DRD. REG 2-14-73
660:         ANDI    TAC,-1          ;RIGHT SIDE ONLY
661:         HRRZ    LOC,PROG        ;ABS. LOC. OF OLD CORE
662:         HLRZ    BLK,PROG        ;HIGHEST LEGAL REL. ADR.
663:         JUMPE   TAC,CORG2
664:         CAILE   TAC,(BLK)       ; IS HE EXPANDING?
665:         JRST    CORG2           ; YES, LET HIM
666:         CAIN    TAC,(BLK)       ; NO, IS HE THE SAME?
667:         JRST    DIDLEA          ; YES, LEAVE NOW
668:         ADDI    LOC,1(TAC)      ; OTHERWISE, SHRINK HIM IN PLACE
669:         SUBI    BLK,1(TAC)
670:         HRL     PROG,TAC
671:         MOVEI   UCHN,0
672:         PUSHJ   P,CORSTG
673:         JRST    DIDLEA
674: 
675: SHFCOR: PUSHJ   P,ANYACT
676:         POPJ    P,
677:         PSYNC   CORCSC
678:         ANDI    TAC,-1          ;RIGHT SIDE ONLY
679:         HRRZ    LOC,PROG
680:         HLRZ    BLK,PROG
681: CORG2:  MOVEI   UCHN,0          ;CLEAR FOR CORSTG CALL
682:         PUSHJ   P,CORSTG        ;RETURN OLD CORE TO FREE STORAGE
683:         JRST    CORG1
684: 
685: ;CORGET IS CALLED BY SWAPPER WHEN JOB IS ON DISC AND IS WANTED IN CORE.
686: 
687: ↑CORGET:
688:         CAML    TAC,SWAPLIMIT   ;CAN HE HAVE THIS MUCH?
689:         POPJ    P,
690:         PSYNC   CORCSC
691: CORG1:  SETZB   LOC,PROG        ; SET NEW ASSIGNMENT TO 0 AND DIST. MOVED
692:         AOS     NCORCALLS
693:         JUMPE   TAC,DIDLE2      ;IS ZERO CORE BEING REQUESTED?
694:         CAME    J,SHFWAT        ;WAITING FOR CURRENT JOB?
695:         SKIPN   SHFWAT          ;IF SHUFFLING, PRETEND NOT AVAIL.
696:         PUSHJ   P,HOLSRC        ;NO, SEARCH FOR HOLE BIG ENOUGH
697:         JRST    BAKOLD          ;NONE, GIVE BACK OLD AMOUNT
698: CORGT1: MOVEM   LOC,PROG        ;SETUP NEW RELOC
699:         HRLM    TAC,PROG        ;AND NEW PROTECT.
700:         MOVEI   BLK,(TAC)       ;HIGHEST REL ADR. BEING REQUESTED
701:         MOVE    UCHN,J          ;SET USE BITS IN CORE TABLE
702:         PUSHJ   P,CORSTG
703:         MOVE    BLK,JBTADR(J)   ;OLD CORE ASSIGNMENT
704:         JUMPN   BLK,MOVCOR      ;WAS THERE OLD MEMORY ASSIGNED?
705:         PUSHJ   P,CLRJB1        ;CLEAR JOB DATA AREA
706:         MOVE    UCHN,JBTSTS(J)
707:         TLNE    UCHN,SWP        ;IS JOB COMING IN FROM DISK?
708:         JRST    DIDLEA
709:         MOVSI   UCHN,JERR       ; SET ERROR BIT IN JOB STATUS WORD
710:         ORM     UCHN,JBTSTS(J)
711:         MOVNI   UCHN,STOPQ      ; PUT JOB IN STOP QUEUE
712:         MOVEM   UCHN,JOBQUE(J)
713:         PUSHJ   P,REQUE
714:         JRST    DIDLEA
    CORE page# 0009 next  prev
716: BAKOLD:
717: IFN FTSWAP,<;IN SWAPPING SYSTEM STORAGE LIMIT INSTEAD OF CORE
718: ;LIMIT USED TO DETERMINE IF REQUEST IS GRANTED.
719: 
720:         MOVSI   UCHN,SWP
721:         TDNN    UCHN,JBTSTS(J)  ;GETTING CORE FOR SWAPPER?
722:         JRST    CORGT3
723:         SOS     (P)             ;YES, SET FAILURE RETURN
724:         JRST    DIDLE4
725: 
726: CORGT3: JUMPL   TAC,CORGT2      ; A NEGATIVE CORE AMOUNT IS AN ERROR?
727:         CAMGE   TAC,SWAPLIMIT   ;GTR SWAP AREA?
728:         CAML    TAC,CORMAX      ;WILL REQUEST FIT IN PHYSICAL CORE?
729: CORGT2: SOSA    (P)             ;NO - GIVE ERROR RETURN
730:         PUSHJ   P,XPAND         ;YES - TELL SWAPPER TO SWAP OUT
731: >
732: IFE FTSWAP,<    SOS     (P)     ;SET FOR ERROR RETURN
733: >
734:         HLRZ    TAC,JBTADR(J)   ;GIVE BACK OLD CORE.
735:         HRRZ    LOC,JBTADR(J)   ;RETURN OLD CORE
736:         TRNN    LOC,-1          ;ANY CORE TO RETURN?
737:         JRST    DIDLE4          ;NO.  JUST EXIT.
738:         JRST    CORGT1
    CORE page# 0010 next  prev
740: ;MOVE OLD CORE TO NEW AREA
741: 
742: MOVCOR: CAIN    LOC,(BLK)       ;IS NEW CORE IN SAME PLACE AS OLD?
743:         JRST    DIDLE           ;YES, DO NOT MOVE IT
744:         MOVSI   TAC1,INTSHW     ; DO WE INTERRUPT THIS GUY FIRST?
745:         TDNN    TAC1,JBTIEN(J)
746:         JRST    MOVCO1          ; NO
747:         IORM    TAC1,JBTIRQ(J)  ; YES
748:         PUSH    P,J
749:         PUSH    P,BLK
750:         PUSH    P,LOC
751:         PUSH    P,TAC
752:         PUSH    P,PROG
753:         PUSHJ   P,INTRUN        ;MAKE INTERRUPT HAPPEN
754:         POP     P,PROG
755:         POP     P,TAC
756:         POP     P,LOC
757:         POP     P,BLK
758:         POP     P,J
759: MOVCO1: 
760: IFN FTSHF1K,<
761:         SKIPN   SPWACT          ; IS THERE A SPACEWAR JOB ACTIVE?
762:         JRST    ISET2           ; NO, DO IT ALL IN ONE BIG BLT
763: ;;; THE FOLLOWING J. SAUTER CODE (+ OTHER BITS AND PIECES AROUND
764: ;;; AT NOTSH1 AND CLKSER) IS DE-ACTIVATED FOR EFFECIENCY'S SAKE
765: 
766: ;CALC AMT TO GIVE BACK AFTER MOVING
767: ;BLK = XWD LENGTH OF OLD CORE,BOTTOM OF OLD CORE
768: ;TAC = LENGTH OF NEW CORE
769: ;LOC = BOTTOM OF NEW CORE
770: 
771:         MOVEM   BLK,SHFBLK
772:         HLRZ    TAC1,BLK        ;LENGTH OF OLD
773:         ADDI    TAC1,(BLK)      ;TOP OF OLD
774:         CAIL    LOC,(TAC1)      ;BOTTOM OF NEW ABOVE TOP OF OLD
775:         JRST    ISET            ;YES. AREAS ARE DISJOINT
776:         MOVE    TAC1,TAC        ;LENGTH OF NEW CORE
777:         ADD     TAC1,LOC        ;TOP OF NEW CORE
778:         CAIG    TAC1,(BLK)      ;ABOVE BOTTOM OF OLD?
779:         JRST    ISET            ;NO. AREAS ARE DISJOINT
780:         HRRZM   TAC1,SHFBLK
781:         HLRZ    TAC1,BLK        ;AREAS OVERLAP.
782:         ADDI    TAC1,(BLK)
783:         SUB     TAC1,SHFBLK
784:         JUMPLE  TAC1,ISET1      ;AMOUNT LEQ 0.  RETURN NONE.
785:         SUBI    TAC1,1
786:         HRLM    TAC1,SHFBLK
787:         AOS     SHFBLK
788: ISET:   PUSH    P,BLK           ;GRAB THE OLD CORE UNTIL DONE
789:         PUSH    P,LOC
790:         HRRZ    LOC,SHFBLK
791:         HLRZ    BLK,SHFBLK
792:         MOVE    UCHN,J          ;I HOPE J IS SET UP HERE
793:         PUSHJ   P,CORSTG        ;GET BACK OLD CORE
794:         POP     P,LOC
795:         POP     P,BLK
796:         JRST    ISET2
797: 
798: ISET1:  SETZM   SHFBLK          ;DONT GIVE ANYTHING BACK.
799: >;END OF IFN FTSHF1K
800: 
801: ISET2:  HLRZ    TAC1,BLK        ;LENGTH OF OLD CORE
802:         CAILE   TAC1,(TAC)      ;IS OLD CORE LESS THAN NEW?
803:         HRRZ    TAC1,TAC        ;NO, MOVE THE SHORTENED NEW CORE
804:         ADDM    TAC1,SHFWRD     ;INCREMENT TOTAL NO. WORDS SHUFFLED
805:         ADD     TAC1,LOC        ;ADD IN NEW RELOC.
806:         MOVE    TAC,LOC         ;DEST.=NEW RELOC.
807:         HRL     TAC,BLK         ;SOURCE=OLD RELOC.
808:         MOVEM   BLK,PARBLK      ;SAVE THIS FOR PARSER.
809:         SETZM   JBTADR(J)       ;FLAG THAT CORE IS IN TRANSIT(TTY ROUTINES)
810: 
811: IFN FTSHF1K,<
812:         SKIPN   SPWACT          ; IS THERE A SPACEWAR JOB ACTIVE?
813:         JRST    MOVC1           ; NO, DO IT ALL IN ONE BLT
814:         ADDI    TAC1,1
815:         MOVEM   TAC1,SHFEND     ;RECORD THE END OF THE BLT
816:         MOVE    TAC1,[XWD 2000,2000]
817:         ADD     TAC1,TAC        ;BLT THE FIRST 1K NOW.
818:         MOVEM   TAC1,SHFTAC     ;WHERE TO START NEXT TIME
819:         BLT     TAC,-1(TAC1)    ;MOVE JOB DATA AREA.
820:         SETOM   SHFWAT          ;NOTE THAT A JOB IS MOVING.
821:         MOVSI   TAC,SHF         ;DONT RUN HIM UNTIL STOPPED
822:         IORM    TAC,JBTSTS(J)
823:         MOVEM   J,SHFJOB
824:         JRST    DIDLE
825: >;END OF IFN FTSHF1K
826: 
827: MOVC1:
828: 
829: IFN FTSHF1K,<
830:         SETZM   SHFTAC          ; ZERO OUT CLKINT COMMUNICATION CELLS
831:         SETZM   SHFEND
832:         SETZM   SHFJOB          ; MAKE SURE NOTSH1 IS CALLED!
833: >;IFN FTSHF1K
834: 
835: IFN FTHG,<PUSH  P,HGCODE
836:         HGMAC   (30)    >
837:         MOVEM   J,PARSJB        ;FOR PARSER, THE JOB BEING SHUFFLED
838: ↑SHFBLT:
839:         BLT     TAC,(TAC1)      ;LABEL THIS FOR PARSER.
840: IFN FTHG,<POP   P,HGCODE>
841:         PUSHJ   P,DIDLE         ; REFORM CORE PARAMETERS NOW
842:         JFCL
843:         AOS     (P)             ;SET UP FOR SKIP RETURN
844: ↑SHFDONE:
845:         MOVSI   TAC1,INTSHD
846:         TDNN    TAC1,JBTIEN(J)
847:         POPJ    P,
848:         IORM    TAC1,JBTIRQ(J)
849:         PUSH    P,J
850:         PUSH    P,BLK
851:         PUSH    P,LOC
852:         PUSH    P,PROG
853:         PUSHJ   P,INTRUN        ;RUN USER I-LEVEL FOR END OF SHUFFLE
854:         POP     P,PROG
855:         POP     P,LOC
856:         POP     P,BLK
857:         POP     P,J
858:         POPJ    P,
    CORE page# 0011 next  prev
860: SUBTTL  DIDDLE
861: ;IF THE SHUFFLED JOB IS IN EXEC MODE, ITS DUMP ACS
862: ;(P,PROG,JDAT SAVED IN JOB DATA AREA) MUST BE
863: ;ALTERED BY DISTANCE CORE WAS MOVED
864: 
865: ;IF THE SHUFFLED JOB IS CURRENT JOB, THE SOFTWARE STATE OF
866: ;THE MONITOR(IE SOFTWARE OF JOB) NUST BE ALTERED BY AMOUNT
867: ;CORE WAS MOVED
868: 
869: DIDLEA: MOVE    TAC,JBTSTS(J)
870:         TLNE    TAC,JSEG        ;UPPER SEGMENTS TAKE 2 GIANT STEPS!
871:         JRST    DIDLE3
872:         JRST    DIDLE1
873: 
874: 
875: DIDLE:  SUBI    LOC,(BLK)       ;DISTANCE JOB WAS MOVED(DEST.-SOURCE)
876:         MOVE    TAC,JBTSTS(J)   ; IS THIS A HIGH SEGMENT?
877:         TLNN    TAC,JSEG
878:         JRST    DIDLE6
879:         PUSH    P,J             ;YES, RECALCULATE PROT-RELOC OF LOWER SEGMENT
880:         MOVE    J,JOB
881:         LDB     TAC,PSEGN
882:         CAME    TAC,(P)
883:         JRST    DIDLE5
884:         PUSHJ   P,GETPR
885:         DATAO   APR,TAC
886: DIDLE5: POP     P,J
887:         JRST    DIDLE3
888: 
889: DIDLE6: CAME    J,JOB(PID)      ;IS THIS CURRENT JOB?
890:         SKIPA   TAC,JOBPC(JDAT) ;NO, GET PC IN JOB DATA AREA
891:         MOVE    TAC,USRPC(PID)  ;YES, PC IN PROTECTED SYSTEM AREA
892:         TLNE    TAC,USRMOD      ;IS JOB IN USER MODE?
893:         JRST    DIDLE1          ;YES, DO NOT ALTER DUMP ACS
894:                                 ;BECAUSE THEY ARE THE USERS
895:         HRRZ    TAC,JOBDAC+P(JDAT)
896:         CAMLE   TAC,SYSSIZ      ; IS THIS PDL IN USER'S AREA?
897:         CAML    TAC,MEMSIZ
898:         JRST    .+2             ; NO
899:         ADDM    LOC,JOBDAC+P(JDAT)
900:                                 ; YES, RELOCATE PDL WITH JOB
901:         ADDM    LOC,JOBDPG(JDAT)        ;AND ALTER PROG BY DIST. MOVED
902: DIDLE1: HLRZM   PROG,JOBREL(JDAT)       ;ALWAYS SET JOB DATA AREA W/PROTECTION
903: DIDLE2: CAME    J,JOB(PID)      ;IS THIS CURRENT JOB?
904:         JRST    DIDLE3          ;NO, DO NOT ALTER STATE OF MONITOR
905:         HRRZI   TAC,(P)         ; SEE IF THIS PDL IS IN USER'S AREA
906:         CAMLE   TAC,SYSSIZ      ; IS IT ABOVE TOP OF SYSTEM
907:         CAML    TAC,MEMSIZ              ; AND BELOW FREE STORAGE AREA?
908:         JRST    .+2             ; NO
909:         ADDM    LOC,P           ; YES, RELOCATE PDL
910:         MOVEM   PROG,JOBADR(PID)        ;SET NEW JOB ADR. FOR CURRENT JOB
911: IFN FTSTAT,<
912:         CAME PROG,JBTADR(J)
913:         PUSHJ P,CSTAT
914: >
915:         MOVEM   PROG,JBTADR(J)
916:         HLRZM   PROG,USRREL(PID)        ;SET NEW PROTECTION FOR CURRETN JOB
917:         PUSHJ   P,GETPR         ; GET JOB'S PROT-RELOC IN TAC
918:         DATAO   APR,TAC         ; AND PUT THAT OUT
919: DIDLE3:
920: IFN FTSTAT,<
921:         CAME PROG,JBTADR(J)
922:         PUSHJ P,CSTAT
923: >
924:         MOVEM   PROG,JBTADR(J)  ;STORE NEW CORE ASSIGNMENT
925: DIDLE4: SETZB   TAC,HOLEF       ;CLEAR HOLE FLAG
926:         PUSHJ   P,HOLSRC        ;IS THERE A NON-ZERO HOLE?
927:         JRST    COROK           ;NO
928:         ADDI    LOC,1(BLK)      ;YES, FORM ADR. OF JOB JUST ABOVE HOLE
929:         CAMGE   LOC,MEMSIZ      ;IS HOLE AT TOP OF MEMORY?
930:         MOVEM   LOC,HOLEF       ;NO, FLAG WITH ADDRESS OF JOB ABOVE HOLE
931: COROK:
932: IFN FTSWAP,<
933:         MOVEI   TAC,-1          ;FIND BIGGEST HOLE
934:         PUSHJ   P,HOLE          ;ALWAYS GET ERROR RETURN
935:         ASH     AC2,-=10        ;CONVERT TO 1K BLOCKS
936:         MOVEM   AC2,BIGHOLE
937: >
938:         SCHEDULE
939:         XSYNC   CORCSC
940: IFN FTCORBUG,<  PUSHJ   P,CORTCK >      ;CHECK FOR CORTAB - JBTADR CONSISTENCY
941:         JRST    CPOPJ1          ;SKIP RETURN(UNLESS ERROR)
942: 
    CORE page# 0012 next  prev
944: ;CSTAT, STAPUT, STAPTT          STATISTICS SERVICE
945: IFN FTSTAT,<
946: CSTAT:  MOVE TAC,JBTSTS(J)
947:         TLNE TAC,SWP            ;IF SWAPPER,
948:         JRST CSTAT0             ;THEN IS ONLY POSITION CHANGE
949:         MOVE TAC,PROG
950:         XOR TAC,JBTADR(J)
951:         TLNN TAC,776000         ;CHANGE IN PROT?
952:         JRST CSTAT1
953:         HLRZ TAC,PROG
954:         LSH TAC,-4
955:         TRZ TAC,77
956:         MOVEI TAC,CSZSTA+100(TAC);ADD CODE AND MAKE INTO K
957:         PUSHJ P,STAPUT
958: CSTAT1: JUMPE PROG,CPOPJ        ;REPORT ONLY PROT IF CORE 0
959:         MOVE TAC,PROG
960:         XOR TAC,JBTADR(J)
961:         TRNN TAC,776000
962:         POPJ P,
963: CSTAT0: HRRZ TAC,PROG
964:         LSH TAC,-4
965:         TRO TAC,CPSSTA
966: ↑STAPUT:IORI TAC,(J)
967: STAPTT: CONSO PI,77000  ;ARE WE ON CHAN HIGHER THAN 7?
968:         JRST STAPOK     ;NO, OK
969:         HRLI TAC,STACLK ;YES, SEND THIS DATA UP TO CH7
970:         CONO PI,PIOFF
971:         IDPB TAC,CLKQ
972:         CONO PI,PION
973:         POPJ P,
974: 
975: STACLK: HRRZ TAC,DAT
976: STAPOK: IDPB TAC,STATPTR
977:         MOVE TAC,STATPTR
978:         CAME TAC,[POINT 18,STATS+STATLEN-1,35]
979:         POPJ P,
980:         MOVE TAC,[POINT 18,STATS]
981:         MOVEM TAC,STATPTR
982:         AOS STATNUM
983:         POPJ P,
984: 
985: ↑GLUSTT:PUSH P,TAC
986:         MOVE TAC,JBTGLU(J)
987:         ANDI TAC,77
988:         LSH TAC,6
989:         TRO TAC,GLUSTA
990:         PUSHJ P,STAPUT
991:         POP P,TAC
992:         POPJ P,
993: 
994: ↑NAMSTT:PUSH P,TAC
995:         MOVEI TAC,NAMSTA(J)
996: ;I HOPE WE DON'T GET INTERRUPTED BY SOMEONE ELSE STORING IN STATUS TABLE
997:         PUSHJ P,STAPTT
998:         HLRZ TAC,JOBNAM(J)
999:         PUSHJ P,STAPTT
1000:         HRRZ TAC,JOBNAM(J)
1001:         PUSHJ P,STAPTT
1002:         POP P,TAC
1003:         POPJ P,
1004: 
1005: ↑SEGSTT:PUSH P,TAC
1006:         LDB TAC,PSEGN
1007:         LSH TAC,6
1008:         TRO TAC,SEGSTA
1009:         PUSHJ P,STAPUT
1010:         POP P,TAC
1011:         POPJ P,
1012: >;FTSTAT
    CORE page# 0013 next  prev
1014: SUBTTL  HOLSRC  
1015: ;ROUTINE TO FIND HOLE BIG ENOUGH FOR REQUEST
1016: ;CALL:  MOVE TAC,HIGHEST REL. ADR. ASKING FOR
1017: ;       PUSHJ P,HOLSRC
1018: ;       RETURN1 ;NO HOLES BIG ENOUGH
1019: ;       RETURN2 ;UCHN BYTE SET TO LAST BLOCK+1 IN HOLE
1020: ;               ;BLK SET TO HIGHEST REL. LOC. IN THAT HOLE
1021: ;               ;LOC SET TO ADDRESS OF FIRST BLOCK IN HOLE
1022: ;               ;AC2=LARGEST HOLE SEEN
1023: ;USES TAC1
1024: 
1025: HOLSRC:
1026: IFN FTSWAP,<
1027:         CAML    TAC,CORMAX      ; IS IT A REASONABLE SIZE REQUEST?
1028: >
1029: IFE FTSWAP,<
1030:         CAML    TAC,MEMSIZ
1031: >
1032:         POPJ    P,              ; NO, GIVE UP NOW
1033: HOLE:   MOVE    UCHN,CORE2P     ; BYTE POINTER TO FIRST BIT-1
1034:         SETZ    AC2,            ;LARGEST HOLE SIZE = 0
1035:         MOVE    LOC,LOKTOP      ;HOLE LOCATION = BOTTOM OF USER SPACE.
1036: CORHOL: TDZA    BLK,BLK         ;START BLK AT 0 AND SKIP
1037: 
1038: CORHO0: ADDI    BLK,2000        ;INCREMENT HIGHEST REL LOC.
1039: CORHO1: CAMN    UCHN,CORLST     ;BYTE POINTER TO 1ST NON-EXISTANT BLOCK
1040:         POPJ    P,              ;NO MORE CORE TO SEARCH
1041:         ILDB    TAC1,UCHN       ;GET NEXT CORE USE BIT
1042:         ADDI    LOC,2000        ;INCREMENT ADDRESS OF BLOCK
1043:         JUMPE   TAC1,CORHO0     ;IS THIS BLOCK IN USE?
1044:         JUMPE   BLK,CORHO1      ;YES, HAVE ANY FREE BLOCKS BEEN SEEN YET?
1045: IFN FTSWAP,<
1046:         CAMLE   BLK,AC2         ;YES, BIGGEST SO FAR?
1047:         MOVEM   BLK,AC2         ;YES, SAVE IN T1.
1048: >
1049:         CAMG    BLK,TAC
1050:                                 ;YES, IS THIS HOLE EQUAL TO OR GREATER
1051:                                 ;THAN THE REQUEST?
1052:         JRST    CORHOL          ;NO, KEEP LOOKING FOR HOLES
1053:         SUBI    LOC,2000(BLK)   ;YES, SET LOC TO FIRST BLOCK IN HOLE
1054:         SUBI    BLK,1           ;SET BLK TO HIGHEST REL. LOC.   ;JS
1055: IFN FTSWAP,<
1056:         CAMGE   TAC,SWAPLIMIT   ;DOES HE WANT MORE THAN 76K?
1057: >
1058:         AOS     (P)             ;NO. GIVE IT TO HIM.    ;JS
1059:         POPJ    P,              ;RETURN                 ;JS
1060:                                 ;AND RETURN
    CORE page# 0014 next  prev
1062: ;CORCHK AND CORTCK  -- CHECK CORTAL AGAINST CORTAB AND CHECK CORTAB AGAINST WORLD
1063: IFN FTCORBUG,<
1064: CORCHK: PUSH    P,TAC           ;MAKE SURE CORTAB AND CORTAL ARE CONSISTENT
1065:         PUSH    P,AC2
1066:         PUSH    P,AC1
1067:         MOVE    AC1,CORE2P      ;BYTE POINTER INTO CORE TABLE
1068:         MOVEI   AC2,0           ;COUNT OF FREE BLOCKS ABOVE LOKTOP
1069: CORCH1: ILDB    TAC,AC1         ;GET CORE TABLE ENTRY
1070:         JUMPN   TAC,CORCH9      ;IF IN USE FORGET IT
1071:         ADDI    AC2,1           ;YES.  FREE BLOCK!
1072: CORCH9: CAME    AC1,CORLST      ;OUT OF MEMORY RANGE YET?
1073:         JRST    CORCH1          ;NO. GO ON
1074:         CAMN    AC2,CORTAL      ;GET RIGHT ANSWER?
1075:         JRST    CORCH8          ;YES
1076: 
1077:         PUSHACS
1078:         PUSHJ   P,DISMES
1079:         ASCIZ   /CORTAL = /
1080:         MOVE    TAC,CORTAL
1081:         PUSHJ   P,DISLOC
1082:         PUSHJ   P,DISMES
1083:         ASCIZ   /,ππππ SHOULD BE = /
1084:         MOVE    TAC,AC2-17(P)
1085:         PUSHJ   P,DISLOC
1086:         PUSHJ   P,DISMES
1087:         ASCIZ   /;     CALLER'S ADDRESS = /
1088:         HRRZ    TAC,-24(P)
1089:         PUSHJ   P,DISLOC
1090:         PUSHJ   P,DISMES
1091:         ASCIZ   /
1092: GET A WIZARD!!  IF YOU CAN'T FIND ONE, TYPE POPJ 3,$X
1093: /
1094:         PUSHJ   P,DISFLU
1095:         PUSHJ   P,DDTCALL
1096:         POPACS
1097:         MOVEM   AC2,CORTAL
1098: 
1099: CORCH8: POP     P,AC1
1100:         POP     P,AC2
1101:         POP     P,TAC
1102:         POPJ    P,
1103: 
1104: CORTCK: PUSH P,AC1
1105:         PUSH P,AC2
1106:         PUSH P,AC3
1107:         PUSH P,LOC
1108:         PUSH P,J
1109:         PUSH P,TAC
1110:         PUSH P,TAC1
1111:         MOVSI AC1,JNA
1112:         MOVE J,JOBNM1
1113: CORCKL: TDNE AC1,JBTSTS(J)
1114:         SKIPN AC2,JBTADR(J)
1115:         JRST CORCKN             ;NO JOB OR ZERO JBTADR
1116:         HRRZ LOC,AC2            ;ADDRESS OF HIS FIRST BLOCK
1117:         HLRZ AC2,AC2            ;PROT
1118:         ADDI AC2,1
1119:         LSH AC2,-=10            ;NUMBER OF 1K BLOCKS
1120:         PUSHJ P,CORGBP          ;SET UP TAC AS ILDB POINTER TO CORTAB
1121: CORCK1: ILDB AC3,TAC
1122:         CAIE AC3,(J)
1123:         JRST CORCKC             ;CORTAB AND JBTADR DISAGREE
1124:         SOJG AC2,CORCK1
1125: CORCKN: SOJG J,CORCKL
1126: 
1127:         MOVE LOC,SYSTOP
1128: CORCK0: PUSHJ P,CORGBP          ;NOW LOOK AT ALL USER STG CORTAB ENTRIES
1129: CORCK2: ILDB J,TAC
1130:         JUMPE J,CORCK3
1131:         CAILE J,77
1132:         JRST CORCK4             ;SYS, NXM, OR FREE STG
1133:         CAMLE J,JOBNM1
1134:         JRST CORCKD             ;JOB NUMBER OUT OF RANGE
1135:         MOVE AC1,JBTADR(J)
1136:         CAIE LOC,(AC1)
1137:         JRST CORCKE             ;NOT FIRST BLOCK OF THIS JOB!
1138:         HLRZ AC2,AC1
1139:         IORI AC2,1777
1140:         ADDI LOC,1(AC2)
1141:         JRST CORCK0
1142: 
1143: CORCK3: ADDI LOC,2000
1144:         CAME TAC,CORLST
1145:         JRST CORCK2
1146: CORCKZ: POP P,TAC1
1147:         POP P,TAC
1148:         POP P,J
1149:         POP P,LOC
1150:         POP P,AC3
1151:         POP P,AC2
1152:         POP P,AC1
1153:         JRST CORCHK             ;NOW CHECK CORTAL
1154: 
1155: CORCK4: CAIN J,101              ;SKIP IF NOT SYS BLOCK
1156:         JRST CORCKF
1157: CORCK5: CAIE J,105              ;SKIP IF FS BLOCK
1158:         JRST CORCK3
1159:         CAMGE LOC,MEMSIZ
1160:         JRST CORCKF             ;NOT IN SYS AREA OR FS
1161:         JRST CORCK3
1162: 
1163: CORCKC: JSP TAC1,CORCKX
1164: CORCKD: JSP TAC1,CORCKX
1165: CORCKE: JSP TAC1,CORCKX
1166: CORCKF: JSP TAC1,CORCKX
1167: 
1168: CORCKX: PUSHACS
1169:         PUSHJ P,DISMES
1170:         ASCIZ /LOSSAGE AT CORCHK -- GET A WIZARD.  THE WINNING ENTRY IS /
1171:         HRRZ TAC,TAC1-17(P)
1172:         SUBI TAC,CORCKC+1
1173:         PUSHJ P,DISOCT
1174:         PUSHJ P,DISCRLF
1175:         PUSHJ P,DISFLU
1176:         PUSHJ P,DDTCAL
1177:         POPACS
1178:         JRST CORCKZ
1179: >;IFN FTCORBUG
    CORE page# 0015 next  prev
1181: SUBTTL  CORSTG          ;ROUTINE TO SET AND CLEAR CORE USE TABLE
1182: ;CALL:  MOVE UCHN,<JOB NUMBER, OR OTHER CODE>   ;TO SET TABLE
1183: ;       MOVEI UCHN,0    ;TO CLEAR TABLE
1184: ;       MOVE BLK,HIGHEST REL. LOC. IN USER AREA
1185: ;       MOVE LOC,ADDRESS OF FIRST BLOCK TO SET OR CLEAR
1186: 
1187: 
1188: 
1189: ↑CORSTG:                        ;THE EXTERNAL CALL IS FROM REMAP IN UUOCON
1190:         PUSH    P,TAC           ;SAVE HIGHEST LOC. BEING REQUESTED
1191:         ASH     BLK,-12         ;CONVERT TO NO. OF BLOCKS-1
1192:         ADDI    BLK,1           ;NO. OF BLOCKS
1193:         JUMPE   UCHN,.+2        ;UPDATE NO OF FREE BLOCKS
1194:         MOVNI   BLK,(BLK)       ;DECREASE IF SETTING BITS
1195:         CAML    LOC,LOKTOP      ;IF THIS IS A CALL IN LOCKED CORE, LOCK AND
1196:                                 ;UNLOCK ARE RESPONSIBLE FOR DIDDLING CORTAL - REG
1197:         ADDM    BLK,CORTAL      ;INCREASE IF CLEARING,DECREASE IF SETTING BITS
1198:         PUSHJ   P,CORGBP        ;MAKE A BYTE POINTER
1199:         MOVM    BLK,BLK         ;GET MAG. OF NO. OF BLOCKS INVOLVED
1200: CORST1: ILDB    TAC1,TAC        ;GET OLD BIT.
1201:         JUMPE   UCHN,CORST9     ;LOOK FOR CONFLICTS
1202:         JUMPN   TAC1,CORST2
1203:         JRST    CORSTD
1204: CORST9: JUMPN   TAC1,CORSTD
1205: CORST2: PUSHACS                 ;LOSER.
1206:         PUSHJ   P,DISDATE
1207:         PUSHJ   P,DISMES
1208:         ASCIZ   /CORTAB LOSES AT CORSTG. OLD CLAIM= /
1209:         MOVE    TAC,TAC1-17(P)  ;GET THE ARGUMENT
1210:         PUSHJ   P,DISDCP        ;TYPE DECIMAL WITH PERIOD
1211:         PUSHJ   P,DISMES
1212:         ASCIZ   /  NEW CLAIM = /
1213:         MOVE    TAC,UCHN-17(P)  ;GET NEW CLAIM
1214:         PUSHJ   P,DISDCP        ;TYPE DECIMAL W/PERIOD
1215:         PUSHJ   P,DISCRLF
1216:         POPACS
1217: CORSTD: DPB     UCHN,TAC        ;STORE NEW CORE USE BITS.
1218:         SOJG    BLK,CORST1
1219: IFN FTCORBUG,<  PUSHJ   P,CORCHK  >     ;MAKE SURE CORTAB AND CORTAL ARE RIGHT
1220:         JRST    TPOPJ           ;RESTORE TAC, AND POPJ
1221: 
1222: 
1223: ↑CORGBP:                        ;(ALSO CALLED FROM PARSER)
1224:                                 ;MAKE A BYTE POINTER TO CORTAB
1225:         MOVE    TAC,LOC         ;ADDRESS OF FIRST BLOCK
1226: CORGB1: MOVEI   TAC1,0          ;ENTER HERE WITH TAC SET UP.
1227:         LSHC    TAC,-14         ;FORM BYTE POINTER TO BIT-1
1228:         ROT     TAC1,2
1229:         ADD     TAC,COREP(TAC1) ;FORM BYTE POINTER
1230:         POPJ    P,
    CORE page# 0016 next  prev
1232: SUBTTL  CLRJOB
1233: ;ROUTINE TO CLEAR PART OF JOB DAT AREA(PART PROTECTED FROM USER IO)
1234: ;CALLED WHEN NEW CORE ASSIGNED AND AT SYSTEM RESTART(140)
1235: ;       MOVE J,JOB NO.
1236: ;CALL:  MOVE JDAT,ADR. OF JOB DATA AREA
1237: ;       PUSHJ   P,CLRJOB
1238: 
1239: 
1240: ↑CLRJB1:
1241:         MOVE    UCHN,JBTSTS(J)  ; CAN'T DO THIS IF NO JOB DATA AREA
1242:         TLNE    UCHN,JSEG       ; IS THIS AN UPPER SEGMENT
1243:         POPJ    P,              ; YES, JUST FORGET IT
1244:         SETZM   JOBPRT(JDAT)    ;FIRST LOC. PROTECTED FROM USER
1245:         MOVSI   TAC,JOBPRT(JDAT)
1246:         HRRI    TAC,JOBPR1(JDAT)
1247:         BLT     TAC,JOBPFI(JDAT)
1248:         SETZM   JOBENB(JDAT)    ;ALSO CLEAR APR ENABLE WORD
1249:         SETZM JOBINT(JDAT)      ;AND MOORER RELOCATER
1250:         MOVE    TAC,JBTSTS(J)
1251:         TLNN    TAC,SWP!SHF     ; FORGET THIS IF SWAPPING REQUEST
1252:         HRRZS   UUOPC(J)        ; AND UUO PC FLAGS
1253:         POPJ    P,              ;RETURN
1254: 
1255: ↑CLRJOB:
1256:         PUSHJ   P,CLRJB1        ; CLEAR JOB DATA AREA
1257:         JRST    ESTOP2          ; GO SET JOB STATUS, SO CONT WILL
1258:                                 ;NOT WORK
1259: 
1260: ↑CLRINI:
1261:         PUSH    P,JOBDDT(JDAT)  ; ON 200 RESTARTS, SAVE JOBDDT
1262:         PUSHJ   P,CLRJB1
1263:         POP     P,JOBDDT(JDAT)
1264:         JRST    ESTOP2
    CORE page# 0017 next  prev
1266: SUBTTL  GETPR
1267: ; ROUTINE TO GET A JOB'S PROTECTION-RELOCATION
1268: 
1269: ↑GETPR:
1270:         PUSH    P,DAT           ; SAVE SOME ACCUMULATORS
1271:         PUSH    P,TAC1
1272:         MOVE    TAC,JBTADR(J)   ; START WITH THE MAIN PART
1273:         ANDCM   TAC,[XWD 1777,1777]
1274:         LDB     DAT,PSEGN
1275:         JUMPE   DAT,GETPR4      ; IF NO UPPER SEGMENT, WE ARE DONE
1276:         MOVE    TAC1,JBTSTS(DAT)        ; HE HAS AN UPPER, IS IT WRITE-PROTECTED?
1277:         TLNE    TAC1,JWP
1278:         TLO     TAC,1           ; YES, SET WRITE-PROTECT BIT
1279:         SKIPN   TAC1,JBTADR(DAT)
1280:         JRST    GETPR1
1281: GETPR5: HLRZ    DAT,JBTADR(J)
1282:         CAIGE   DAT,400000
1283:         JRST    GETPR3
1284:         SUBI    TAC1,(DAT)      ; FUDGE RELOCATION BY RIGHT AMOUNT
1285:         HRLZ    DAT,DAT
1286:         ADD     TAC1,DAT        ; AND PROTECTION
1287:         JRST    GETPR2
1288: GETPR3: TRC     TAC1,400000
1289: GETPR2: TLO     TAC1,400000
1290:         LSH     TAC1,-11
1291:         AND     TAC1,[XWD 776,776]
1292:         OR      TAC,TAC1        ; MERGE TWO RELOCATIONS
1293: GETPR1: MOVEM   TAC,LASTPR(PID) ; SAVE THIS AS THE LAST PROT-RELOC ISSUED
1294:         POP     P,TAC1
1295:         POP     P,DAT
1296:         POPJ    P,
1297: 
1298: GETPR4: SKIPN   TAC1,JBTPR2(J)  ;IS DOING PEEK-POKE STUFF?
1299:         JRST    GETPR1          ;NO
1300:         TLNE    TAC1,1          ;IS IT TO BE WRITE PROTECTED?
1301:         TLO     TAC,1           ;YES
1302:         TRZN    TAC1,1          ;IS IT TO BE RELATIVE TO HIS CORE IMAGE?
1303:         JRST    GETPR5
1304:         PUSH    P,TAC           ;YES, CHECK TOP OF HIS CORE IMAGE
1305:         HLRZ    TAC,TAC1        ;PROTECTION HE IS REQUESTING
1306:         IORI    TAC,1777        ;MAKE IT HONEST
1307:         HLRZ    DAT,JBTADR(J)   ;HIS JOBS PROTECTION
1308:         CAIG    DAT,(TAC1)      ;IS RELOC BELOW LOWERS PROT?
1309:         JRST    GETPR6
1310:         IORI    DAT,1777        ;JUST TO BE SAFE
1311:         SUBI    DAT,(TAC1)      ;HOW FAR FROM NEW RELOCATION TO TOP OF CORE IMAGE.
1312:         CAML    DAT,TAC         ;IS HE REQUESTING TO MUCH?
1313:         MOVE    DAT,TAC         ;NO, USE WHAT HE GAVE US
1314:         POP     P,TAC           ;GET BACK LOWERS PROT. RELOC.
1315:         HRL     TAC1,DAT        ;SET NEW PROT. FOR PR2
1316:         ADDI    TAC1,(TAC)      ;AND RELOCATE IT
1317:         JRST    GETPR5          ;AND NOW IT LOOKS LIKE AN UPPER
1318: GETPR6: POP     P,TAC
1319:         TLZ     TAC,1
1320:         JRST    GETPR1
    CORE page# 0018 next  prev
1322: SUBTTL  RELOCA
1323: ;THIS HERE IS A ROUTINE TO ADDRESS CHECK AND RELOCATE
1324: ;A USER ADDRESS. IT MAKES USE OF UPPER SEGMENTS AND
1325: ;THE PEEK-POKE FEATURE (JBTPR2).
1326: ;CALLING:
1327: ;       MOVE J,<NUMBER OF JOB IN QUESTION>
1328: ;       MOVE TAC1,<ADDRESS TO CHECK AND RELOCATE>
1329: ;       PUSHJ P,RELOCA
1330: ;       <ILLEGAL ADDRESS>
1331: ;       <LEGAL ADDRESS>
1332: ;UPON SUCCESS RETURN TAC1 CONTAINS THE ABSOLUTE ADDRESS
1333: ;THE SIGN BIT IS SET IF THIS ADDRESS IS WRITE PROTECTED
1334: ;FROM THE USER (THIS INCLUDES THE PROTECTED PART FROM 0-JOBPFI).
1335: ;AC1 IS NOW SET-UP FOR A CALL ON RELOCB.
1336: 
1337: ↑↑RELOCA:
1338:         TLZ TAC1,-1             ;CLEAR CONFUSING BITS!
1339:         CAIGE TAC1,JOBPFI       ;BELOW PROTECTED PART?
1340:         TLO TAC1,400000         ;SET WRITE PROTECTED ACCESS
1341:         PUSH P,TAC              ;SAVE AN AC
1342:         HLRZ TAC,JBTADR(J)      ;GET PROT
1343:         CAIGE TAC,(TAC1)        ;IS IT OUTSIDE LOWER?
1344:         JRST RELOC1             ;YES, THIS IS HARDER
1345:         MOVE AC1,JBTADR(J)      ;SET-UP AC1 WITH PROT RELOC WE ARE USING
1346:         ADDI TAC1,(AC1)         ;DO RELOCATION THING
1347:         JRST TPOPJ1             ;PUT BACK TAC AND SKIP
1348: 
1349: RELOC1: LDB AC1,PSEGN           ;CHECK FOR UPPER SEGMENT
1350:         JUMPE AC1,RELOC2        ;NONE, CHECK PEEK-POKE
1351:         MOVSI TAC,JWP           ;CHECK WRITE PROTECT
1352:         TDNE TAC,JBTSTS(AC1)
1353:         TLO TAC1,400000         ;WRITE PROTECTED
1354:         MOVE AC1,JBTADR(AC1)    ;GET PROT RELOC INTO AC1
1355:         JRST RELOC3
1356: 
1357: RELOC2: SKIPN AC1,JBTPR2(J)     ;IS HE DOING PEEK-POKE
1358:         JRST TPOPJ              ;RESTORE TAC AND RETURN
1359:         TLOE AC1,1              ;IS HE WRITE PROTECTED(SET BIT FOR COMPARE)
1360:         TLO TAC1,400000         ;YES
1361:         TRZN AC1,1              ;IS THIS A RELATIVE MAPPING?
1362:         JRST RELOC3             ;NO, (WHEW)!
1363:         PUSH P,DAT              ;OH BOY, SAVE ANOTHER AC
1364:         HLRZ TAC,AC1            ;GET RELOC HE IS TRYING FOR
1365:         IORI TAC,1777           ;MAKE IT HONEST
1366:         HLRZ DAT,JBTADR(J)      ;GET PROT OF LOWER
1367:         CAIG DAT,(AC1)          ;IS THE RELATIVE RELOC HE WANTS TOO BIG?
1368:         JRST RELOC4             ;YES, LOSE
1369:         SUBI DAT,(AC1)          ;GET MAX PROT HE CAN HAVE
1370:         CAML DAT,TAC            ;IS HE ASKING FOR MORE THAN THAT?
1371:         MOVE DAT,TAC            ;NO, USE HIS
1372:         ADD AC1,JBTADR(J)       ;SET ABSOLUTE RELOCATION
1373:         HRL AC1,DAT             ;SET PROT.
1374:         POP P,DAT               ;GET BACK THE AC WE SAVED
1375: RELOC3: HLRZ TAC,JBTADR(J)      ;NOW WE CHECK TO SEE
1376:         CAIGE TAC,400000        ;IF HIS LOWER IS BIGGER THAN 400000
1377:         MOVEI TAC,400000        ;IT ISN'T, USE 400000
1378:         SUB TAC1,TAC            ;ADJUST REFERENCE
1379:         TLNE TAC1,377777        ;UNDERFLOW?
1380:         JRST TPOPJ              ;YES, BETWEEN UPPER AND LOWER!
1381:         HLRZ TAC,AC1            ;GET PROT.
1382:         CAIL TAC,(TAC1)         ;TOO BIG?
1383:         AOS -1(P)               ;NO, SKIP
1384:         JRST TPOPJ              ;RESTORE TAC AND RETURN
1385: 
1386: RELOC4: POP P,DAT
1387:         JRST TPOPJ              ;LOSE
1388: 
1389: ;USE THIS ROUTINE AFTER CALLING RELOCA ONCE TO ASSURE
1390: ;THAT THE ADDRESS YOU ARE CHECKING IS IN THE SAME
1391: ;SEGMENT AS THE LAST ONE YOU CHECKED. DON'T CLOBBER
1392: ;AC1 BETWEEN CALLS ON RELOCA AND RELOCB
1393: ;CALLING:
1394: ;       MOVE J,<NUMBER OF JOB IN QUESTION>
1395: ;       MOVE TAC1,<ADDRESS YOU WISH CHECKED>
1396: ;       PUSHJ P,RELOCB
1397: ;       <ILLEGAL ADDRESS OR NOT IN SAME SEGMENT AS AC1>
1398: ;       <LEGAL ADDRESS AND IN RIGHT SEGMENT>
1399: 
1400: ↑↑RELOCB:
1401:         PUSH P,AC1              ;SAVE PROT RELOC WE USED LAST!
1402:         PUSHJ P,RELOCA          ;DO THE RELOC THING
1403:         JRST RELOC5
1404:         POP P,(P)
1405:         EXCH AC1,1(P)
1406:         CAMN AC1,1(P)           ;DID RELOCA USE PROT RELOC WE WANTED?
1407:         AOS (P)                 ;YES, SUCCESS
1408:         POPJ P,
1409: 
1410: RELOC5: POP P,AC1
1411:         POPJ P,                 ;LOSE
    CORE page# 0019 next  prev
1413: SUBTTL  LOCK AND UNLOCK UUOS.
1414: ↑UNLOKC:MOVEI   J,(DAT)                 ;CALLED FROM CLOCK RQ AT ESTOP4
1415: ↑UNLOCK:
1416:         PUSH    P,TAC
1417:         MOVEI   TAC,JLOCK
1418:         TDNN    TAC,JBTSTS(J)           ;IS JOB LOCKED IN AT ALL?
1419:         JRST    TPOPJ                   ;NO. THIS IS EASY.
1420:         PUSH    P,PROG
1421:         ANDCAM  TAC,JBTSTS(J)           ;UNLOCK HIM.
1422: IFN FTSTAT,<
1423:         MOVEI TAC,LOKSTA
1424:         PUSHJ P,STAPUT
1425: >;FTSTAT
1426:         MOVE    PROG,JBTADR(J)          ;GET THE ADDRESS OF THIS JOB.
1427:         HLRZ    TAC,PROG
1428:         IORI    TAC,1777                ;DEPT REDUNDANCY DEPT.
1429:         ADDI    TAC,1(PROG)             ;COMPUTE ADDRESS ABOVE THIS JOB.
1430:         CAME    TAC,LOKTOP              ;SAME AS LOKTOP?
1431:         JRST    UNLOK4
1432: 
1433: UNLOK0: PUSH    P,TAC1
1434:         MOVEI   PROG,(PROG)             ;BOTTOM OF NEW UNLOCKED AREA.
1435: UNLOK1: MOVEI   TAC,-2000(PROG)         ;LOOK 1K FURTHER DOWN.
1436:         PUSHJ   P,CORGB1                ;GET A BYTE POINTER
1437:         ILDB    TAC1,TAC                ;LOAD CORE CODE.
1438:         JUMPE   TAC1,UNLOK2             ;CORE IS FREE. (GIVE BACK TO CORTAL)
1439:         MOVEI   TAC,JLOCK
1440:         CAIGE   TAC1,101                ;CORE IN SYSTEM?
1441:         TDNE    TAC,JBTSTS(TAC1)        ;NO. CORE BELONGS TO UNLOCKED USER?
1442:         JRST    UNLOK3                  ;SYSTEM CORE OR LOCKED USER.
1443:         JRST    .+2
1444: UNLOK2: AOS     CORTAL                  ;UNCLAIMED BLOCK: INCREMENT CORTAL
1445:         SUBI    PROG,2000
1446:         JRST    UNLOK1
1447: 
1448: UNLOK3: MOVEI   TAC,(PROG)
1449:         PUSHJ   P,CORGB1
1450:         MOVEM   TAC,CORE2P              ;SET FOR HOLSRC.
1451:         MOVEM   PROG,LOKTOP
1452: IFN FTCORBUG,<  PUSHJ   P,CORCHK  >     ;MAKE SURE CORTAB AND CORTAL ARE CONSISTENT
1453:         POP     P,TAC1                  ;RESTORE AC'S
1454: UNLOK4: POP     P,PROG
1455:         JRST    TPOPJ
1456: 
1457: LOCK0:  JSP     TAC,UUOMES
1458:         ASCIZ   /CAN'T LOCK WITH SEGMENT
1459: /
1460: 
1461: ↑LOCK:  LDB     TAC1,PSEGN
1462:         JUMPN   TAC1,LOCK0
1463:         SKIPE   LOCKNO
1464:         CAMN    J,LOCKNO
1465:         JRST    LOCK1
1466:         MOVEI   TAC,JIFSEC/2            ;CODE CAN'T BE REENTERED, SO
1467:         PUSHJ   P,SLEEPT                ;LET THIS GUY WAIT.
1468:         JRST    LOCK
1469: LOCK0A: MOVEI   TAC,0
1470:         PUSHJ   P,SLEEP
1471:         JRST    LOCK
1472: 
1473: LOCK1:                                  
1474:         PUSHJ   P,ANYACT                ;WAIT UNTIL IO STOPS.
1475:         JRST    LOCK0A
1476:                                         ;NOW WE DECIDE WHERE TO PUT THIS TURKEY.
1477:         MOVEI   AC2,JLOCK
1478:         TDNE    AC2,JBTSTS(J)           ;ARE WE LOCKED ALREADY?
1479:         PUSHJ   P,UNLOCK                ;YES. UNLOCK FIRST. (SHUFFLES IF POSSIBLE)
1480: LOCK2A: MOVE    LOC,SYSTOP              ;LOWEST POSSIBLE LOC OF HOLE.
1481:         CAML    LOC,LOKTOP              ;TOP OF LOCKED SPACE.
1482:         JRST    LOCK2                   ;LOC CONTAINS ADDRESS.
1483:         PUSHJ   P,CORGBP                ;MAKE A BYTE POINTER
1484:         MOVE    UCHN,TAC                ;BYTE POINTER IN UCHN
1485:         HLRZ    TAC,JBTADR(J)           ;SIZE OF HOLE NEEDED.
1486: LOCK1A: TDZA    BLK,BLK                 ;SIZE OF THIS HOLE.
1487: LOCK1B: ADDI    BLK,2000                ;INCREMENT SIZE OF THIS HOLE.
1488: LOCK1C: CAML    LOC,LOKTOP              ;PASSED THE LOCKED PART?
1489:         JRST    LOCK1D                  ;YES. SEE IF IT WAS IN A HOLE.
1490:         ILDB    TAC1,UCHN               ;PICKUP CORE USE BITS
1491:         ADDI    LOC,2000
1492:         JUMPE   TAC1,LOCK1B             ;JUMP IF STILL IN HOLE.
1493:         CAIGE   TAC1,101                ;SKIP IF THIS IS NOT A JOB
1494:         TDNE    AC2,JBTSTS(TAC1)        ;SKIP IF JOB IS UNLOCKED
1495:         JRST    .+2                     ;IN SYSTEM OR IN LOCKED JOB.
1496:         JRST    LOCK1B                  ;UNLOCKED JOB IS A LOGICAL HOLE.
1497:         JUMPE   BLK,LOCK1C              ;NOT IN HOLE. JUMP IF THERE WAS NO HOLE.
1498:         CAIG    BLK,(TAC)               ;SKIP IF HOLE IS BIG ENOUGH.
1499:         JRST    LOCK1A                  ;NOT BIG ENOUGH.
1500:         SUBI    LOC,2000(BLK)           ;COMPUTE FIRST LOCATION OF HOLE.
1501:         JRST    LOCK2
1502: LOCK1D: SUBI    LOC,(BLK)               ;DECREASE FOR HOLE AT TOP.
1503: LOCK2:  HLL     LOC,JBTADR(J)           ;LOC HAS REL. OF IDEAL HOLE.
1504:         MOVEM   LOC,LOKPOS              ;SAVE ADDRESS OF THE HOLE.
1505:         CAMN    LOC,JBTADR(J)           ;SAME AS WHERE WE ARE NOW?
1506:         JRST    LOCK4                   ;WE'RE IN LUCK. (LOCK)
1507:         PUSHJ   P,LOCK5                 ;SEE IF WE CAN SHUFFLE TO THE RIGHT PLACE.
1508:         JRST    LOCK3                   ;NO. LET THE CLOCK SWAP JOBS OUT.
1509:                                         ;HERE WE HAVE TO MOVE OURSELVES IN.
1510:         PSYNC   CORCSC
1511:         MOVE    PROG,JBTADR(J)
1512:         HLRZ    TAC,PROG
1513:         HRRZ    LOC,PROG
1514:         HLRZ    BLK,PROG
1515:         MOVEI   UCHN,0
1516:         PUSHJ   P,CORSTG                ;FREE OLD CORE.
1517:         HRRZ    LOC,LOKPOS
1518:         PUSHJ   P,CORGT1                ;MAKE IT SHUFFLE
1519:         JFCL                            ;COULD SKIP.
1520: LOCK4:
1521: IFN FTSTAT,<
1522:         MOVEI TAC,LOKSTA+100
1523:         PUSHJ P,STAPUT
1524: >;FTSTAT
1525:         MOVEI   TAC,JLOCK
1526:         IORM    TAC,JBTSTS(J)           ;TELL THEM WE'RE LOCKED IN.
1527:         MOVE    PROG,JBTADR(J)          ;JOB IS NOW IN THE RIGHT PLACE.
1528:         HLRZ    TAC,PROG                ;GET PROT
1529:         IORI    TAC,1777
1530:         ADDI    TAC,1(PROG)             ;FIRST ADDRESS ABOVE THIS JOB
1531:         CAMG    TAC,LOKTOP              ;IS THIS GREATER THAN OLD LOKTOP?
1532:         JRST    LOCK99                  ;NO.  THEN THERE'S NOTHING SPECIAL.
1533:         MOVEM   TAC,LOKTOP
1534: ;CORTAL SHOULD BE OK. JOB WAS MOVED TO CORE WHICH WASN'T LOCKED CORE AT THAT TIME.
1535:         MOVE    LOC,LOKTOP
1536:         PUSHJ   P,CORGBP
1537:         MOVEM   TAC,CORE2P
1538: LOCK99: PUSHJ   P,SPWCNT                ;CONTINUE HIS SPACEWARE JOB IF SUSPENDED
1539:         SETZM   LOCKNO                  ;CLEAR THIS.
1540:         MOVE    TAC,JBTADR(J)
1541:         JRST    STOTAC
1542: 
1543: LOCK5:  HRRZ    LOC,LOKPOS              ;GET BASE LOCATION
1544:         HLRZ    AC3,LOKPOS              ;AND THE PROTECTION.
1545:         PUSHJ   P,CORGBP                ;MAKE A BYTE POINTER IN TAC.
1546: LOCK5A: ILDB    TAC1,TAC                ;GET CORE USE BITS
1547:         CAIN    TAC1,(J)                ;SAME AS OUR JOB
1548:         JRST    CPOPJ1                  ;YES. THEN WE CAN MOVE IN.
1549:         JUMPN   TAC1,CPOPJ              ;SOME ONE IS THERE. WE HAVE TO WORK HARD.
1550:         SUBI    AC3,2000
1551:         JUMPG   AC3,LOCK5A              ;LOOP.
1552:         JRST    CPOPJ1                  ;WE'RE ALL FREE.
1553: 
1554: 
1555: LOCK3:  MOVEM   J,LOCKNO                ;TELL THE SWAPPER TO FOREGO SWAPIN.
1556:         PUSHJ   P,LOCKPL                ;PLANT CLKRQ FOR LOCK.
1557:         MOVNI   TAC,IOWQ                ;REQUE THIS JOB TO IOWQ
1558:         MOVEM   TAC,JOBQUE(J)
1559:         PUSHJ   P,WSCHED                ;WAIT FOR REACTIVATION
1560:         CAME    J,LOCKNO                ;AVOID ↑C CONTINUE HANGUP
1561:         JRST    LOCK                    ;REENTER THE LOCK RESOURCE
1562:         MOVE    LOC,LOKPOS
1563:         JRST    LOCK2A                  ;SEE IF ALL GOOD THINGS HAVE HAPPENED.
1564:         
1565: LOCK3A:                                 ;HERE AT CLOCK LEVEL.
1566:         SKIPGE  FSCLKF                  ;FREE STORAGE DOING IT TOO?
1567:         JRST    LOCKPL                  ;YES. WAIT FOR IT TOO.
1568:         SKIPN   FINISH
1569:         SKIPE   FORCE
1570:         JRST    LOCKPL                  ;WAIT FOR SWAPPER TO BE IDLE.
1571:         SKIPE   J,LOCKNO
1572:         SKIPL   JBTSTS(J)
1573:         JRST    LOCK3C                  ;FLUSH CLOCK RQ IF JOB NOT THERE.
1574:         PUSHJ   P,LOCK5                 ;SEE IF THERE'S A HOLE YET.
1575:         JRST    LOCK3B                  ;NOT YET.
1576:         MOVNI   TAC,TQ
1577:         MOVEM   TAC,JOBQUE(J)           ;SET JOB TO RUN AGAIN
1578:         JRST    REQUE                   ;REQUEUE AND DISMISS CLOCK LEVEL.
1579: 
1580: LOCK3B: MOVEI   J,(TAC1)                ;GET JOB NUMBER OF THE GUY WE'RE FORCING
1581:         MOVE    TAC,JBTSTS(J)
1582:         TLNE    TAC,SHF!SWP             ;SKIP IF HE'S NOT IN MOTION ALREADY
1583:         JRST    LOCKPL                  ;WE'LL HAVE TO WAIT FOR HIM TO STOP MOVING
1584:         HLRZ    TAC,JBTADR(J)
1585:         SKIPN   XJOB(J)                 ;IS HE ALREADY EXPANDING?
1586:         PUSHJ   P,XPAND                 ;NO. LET'S GIVE HIM A SHOVE
1587: LOCKPL: MOVE    TAC,[LOCK3A,,1]         ;PLANT A CLOCK REQUEST.
1588:         CONO    PI,PIOFF
1589:         IDPB    TAC,CLOCK
1590:         CONO    PI,PION
1591:         POPJ    P,
1592: 
1593: LOCK3C: SETZM   LOCKNO
1594:         POPJ    P,
    CORE page# 0020 next  prev
1596: SUBTTL  FREE STORAGE    ;AND OTHER POLITICAL PRISONERS
1597: ; "AND WHO DESERVES THE CREDIT?  AND WHO DESERVES THE BLAME?
1598: ; NIKCOLI IVANOVITCH LOBACHEVSKY IS HIS NAME."
1599: 
1600: ;               JAM - ORIGINAL FREE STORAGE SYSTEM
1601: ;               REG - REVISED SYSTEM MARCH 1972
1602: 
1603: ;       ACCUMULATOR DEFINITIONS
1604: 
1605: SIZE←AC3                ;INPUT PARAMETER TO FSGET
1606: BLOCK←AC1               ;BLOCK ADDRESS OF FS BLOCK (BLK)
1607: 
1608: PICMSK←←37              ;MASK TO SELECT CHANNELS 3,4,5,6,7 IN CONO/I PI
1609: PICHON←←2000            ;BIT TO TURN ON SELECTED CHANNELS: CONO PI
1610: PICHOF←←1000            ;BIT TO TURN OFF SELECTED CHANNELS
1611: 
1612: ;THE FREE STORAGE SYSTEM ASSUMES THAT CHANNELS 1 AND 2 NEVER REQUEST
1613: ;FREE STORAGE.
    CORE page# 0021 next  prev
1615: COMMENT $       INITIALIZE FREE STORAGE
1616: 
1617: MEMSIZ:                 <LOWEST WORD OF FREE STORAGE AREA>
1618: RMEMSIZ:                <LOWEST NON-EX ADDRESS IN ALL CORE>
1619: 
1620: FREE STORAGE LOOKS LIKE:
1621: 
1622: BLOCK IN USE:                   BLOCK THAT IS FREE
1623: 
1624:         (LOW ADDRESS)
1625: 
1626: ---------------                 ---------------
1627: | RS   |  *---|→→→*             |  U   |  *---|→→→*
1628: ---------------   ↓             ---------------   ↓
1629: |             |   ↓             |             |   ↓
1630: |             |   ↓             |             |   ↓
1631: |             |   ↓             |             |   ↓
1632: | DATA AREA   |   ↓             |             |   ↓
1633: |             |   ↓             ---------------   ↓
1634: |             |   ↓             |   0  | BLINK|   ↓
1635: ---------------   ↓             ---------------   ↓
1636: |⊗ SIZE| RS   |←←←*           | SIZE | FLINK|←←←*
1637: ---------------                 ---------------
1638: 
1639:         (HIGH ADDRESS)
1640: 
1641: 
1642: WHERE SIZE IS THE TOTAL SIZE OF THE BLOCK IN WORDS.
1643: THE DATA AREA HAS SIZE-2 WORDS. ⊗SIZE IS SIZE + 400000.
1644: RS IS RESERVED FOR FUTURE USE BY THE FS SYSTEM.
1645: U IS UNDEFINED.
1646: FLINK IS A FORWARD LINK IN A CHAIN OF FREE BLOCKS.
1647: LINKS WILL EVENTUALLY POINT BACK TO THE BASE OF THE CHAIN!
1648: BLINK IS A BACKWARD LINK IN A CHAIN OF FREE BLOCKS.
1649: 
1650: THERE ARE "NFSB" CHAINS OF FREE BLOCK WITH FORWARD AND
1651: BACKWARD POINTERS IN FSAVB TABLE.
1652: 
1653: 
1654: ALL FREE STORAGE BLOCKS ARE SOME MULTIPLE OF THE "TRIVIAL" SIZE.
1655: ALL REQUESTS ARE ROUNDED UP TO SUCH A MULTIPLE.
1656: CHAINS OF FREE BLOCKS OF EACH SIZE ARE KEPT WITH BASE POINTERS IN FSAVB.
1657: $
1658: 
1659: ↑FSINIT:
1660:         SETZM   FSBEG
1661:         MOVE    TAC,[XWD FSBEG,FSBEG+1]
1662:         BLT     TAC,FSEND
1663:         SYNINI  CORCSC                  ;INITIALIZE INTERLOCK CELLS
1664:         SYNINI  FSCSC
1665:         MOVE    LOC,MEMSIZ              ;GET THE SIZE OF USER SPACE
1666:         CAMN    LOC,RMEMSIZ             ;SKIP IF WE HAVE SOME STORAGE CLAIMED
1667:         JRST    FSINI2                  ;NO. WE HAVE NOTHING TO GIVE BACK
1668:         PUSHJ   P,CORGBP                ;GET A POINTER TO OUR LOWEST BLOCK
1669:         MOVEM   TAC,CORLST              ;SAVE AS POINTER TO THE END OF ALL CORE
1670:         MOVEI   AC2,2000
1671: FSINI1: IDPB    AC2,CORLST              ;CLEAR BLOCKS IN CORTAB
1672:         ADDI    LOC,2000                ;ADD TO BOTTOM OF FS.
1673:   AOS     CORTAL                  ;INCREMENT CORE COUNT
1674: IFN FTSWAP,<
1675:         ADDM    AC2,CORMAX >            ;INCREASE USER CORE
1676:         CAME    LOC,RMEMSIZ             ;AT THE TOP YET?
1677:         JRST    FSINI1                  ;NO LOOP
1678: 
1679: FSINI2: MOVEM   LOC,MEMSIZ              ;SAVE RMEMSIZ AS MEMSIZ
1680:         MOVNI   UCHN,FSNINIT            ;NUMBER OF BLOCKS TO CLAIM NOW
1681:         ADDM    UCHN,CORTAL             ;DECREASE USER'S SPACE
1682:         MOVNI   LOC,2000*FSNINIT        ;GET - NUMBER OF WORDS CLAIMED
1683: IFN FTSWAP,<
1684:         ADDM    LOC,CORMAX>             ;DECREASE USER SPACE
1685:         ADDB    LOC,MEMSIZ              ;SET LOWER BOUND OF FS
1686:         PUSHJ   P,CORGBP        
1687:         MOVEI   UCHN,105
1688:         IDPB    UCHN,TAC                ;CLAIM BLOCK FROM CORTAB
1689:         MOVE    AC2,TAC 
1690: FSINI3: CAMN    AC2,CORLST              ;ARE WE AT THE END YET?
1691:         JRST    FSINI4  
1692:         IDPB    UCHN,AC2
1693:       JRST    FSINI3
1694: 
1695: FSINI4: MOVEM   TAC,CORLST              ;SET UP NEW TOP OF CORE POINTER
1696:         IBP     CORLST                  ;MAKE POINT TO 2ND UNAVAIL BLK.
1697:         MOVE    UCHN,[XWD 2000*FSNINIT,FSAVB+2*NFSB-1]  ;SIZE,,FLINK
1698:         MOVE    AC2,RMEMSIZ             ;FIRST NONEX ADDRESS
1699:         SUBI    AC2,1                   ;ADDRESS OF HI END OF FIRST BLOCK
1700:         MOVEM   UCHN,(AC2)              ;SET SIZE,,FLINK IN TOP OF BLOCK
1701:         HRRZM   UCHN,-1(AC2)            ;SET BLINK
1702:         MOVEM   AC2,(LOC)               ;ADDRESS OF TOP GOES INTO BOTTOM
1703:         SETZ    UCHN,
1704: FSINI5: MOVEI   AC3,FSAVB+1(UCHN)       ;GET ADDRESS OF SOMEONE
1705:         MOVEM   AC3,FSAVB(UCHN)         ;SAVE BACK POINTER
1706:         MOVEM   AC3,FSAVB+1(UCHN)       ;SAVE FORWARD POINTER
1707:         ADDI    UCHN,2                  ;INCREMENT BY 2
1708:    CAIGE   UCHN,2*NFSB-2           ;ARE WE AT THE END YET?
1709:         JRST    FSINI5                  ;NO KEEP LOOPING
1710:         HRRZM   AC2,FSAVB+2*NFSB-2      ;SAVE BACK POINTER TO ONLY BLOCK
1711:         HRRZM   AC2,FSAVB+2*NFSB-1      ;SAVE FORWARD POINTER TO ONLY BLOCK
1712:         MOVEI   AC2,JIFSEC*=60          ;NUMBER OF TICKS BETWEEN CHECKER CHECK
1713:         MOVEM   AC2,FSCKCT              ;SAVE
1714:         MOVEI   UCHN,FSLIST             ;GET THE START OF OUR Q SPACE
1715:         MOVEM   UCHN,FSIPTR             ;SAVE AS Q INPUT POINTER
1716:         MOVEM   UCHN,FSOPTR             ;AND Q OUTPUT POINTER
1717:         JRST    SFSINI          ;INITIALIZE FREE STORAGE SPARE LIST USERS
1718: 
1719: 
1720: FSACSV: EXCH    DAT,(P)         ;PUSHJ P,FSACSV TO SAVE AC'S.
1721:         PUSH    P,TAC
1722:         PUSH    P,TAC1
1723:         PUSH    P,AC2
1724:         PUSH    P,SIZE
1725:         PUSH    P,TEM
1726:         JRST    (DAT)
1727: 
1728: 
1729: FSACRS:       POP     P,TEM           ;JSP DAT,FSACRS TO RESTORE AC'S
1730:         POP     P,SIZE
1731:         POP     P,AC2
1732:         POP     P,TAC1
1733:         POP     P,TAC
1734:         EXCH    DAT,(P)
1735:         POPJ    P,
    CORE page# 0022 next  prev
1737: COMMENT $       FSGET:  GET FREE STORAGE AT ANY LEVEL.
1738: CALLING:
1739:         MOVEI   SIZE,<BLOCK SIZE>
1740:         PUSHJ   P,FSGET
1741:         <NONE AVAILABLE>
1742:         <OK - ADDRESS OF BLOCK IS IN BLOCK (AC1)>
1743: 
1744:         UUO LEVEL ALWAYS GETS SUCCESS EXIT
1745: 
1746: $
1747: 
1748: FSSBYP: POINT   17,(BLOCK),17           ;POINTER TO SIZE FIELD OF BLOCK
1749: FSSBP1: POINT   17,(AC2),17             ;POINTER TO SIZE WHEN BLOCK TOP IN AC2
1750: 
1751: ↑FSGET: TDZA    BLOCK,BLOCK             ;NORMAL CALL.
1752: ↑FSGETU:MOVNI   BLOCK,1                 ;CALL AT UUO LEVEL AND NEVER WAIT.
1753:         CONSZ   PI,60000                ;ARE WE BELOW CHANNEL 2?
1754:         JRST    FSGLUZ                  ;NO. SOMEONE SHOULD KNOW BETTER.
1755:         CONSO   PI,77400                ;ANY PI'S IN PROGRESS?
1756:         SKIPE   INTACT(PID)             ;WE'RE AT UUO LEVEL? USER INTERRUPT?
1757:         JRST    .+2                     ;EITHER PI IN PROGRESS OR USER I-LEVEL
1758:         MOVEM   BLOCK,FSGTUF            ;NORMAL UUO LEVEL. SET SPECIAL FLAG.
1759:         AOS     NFSGETS                 ;COUNT FS GETS
1760:         PUSHJ   P,FSACSV                ;SAVE  DAT,TEM,SIZE,AC2,TAC,TAC1
1761:         PSYNC   FSCSC                   ;SYNCHRONIZE WITH OTHER PROCESSOR
1762:         MOVEI   SIZE,2(SIZE)            ;GET SIZE OF REQUEST +2
1763:         TRZE    SIZE,TRIVIAL-1          ;IS THIS EXACT MULTIPLE OF TRIVIAL?
1764:         ADDI    SIZE,TRIVIAL            ;NO. ADD TRIVIAL
1765: FSGETT: MOVEI   TAC,(SIZE)              ;GET SIZE INTO TAC
1766:         LSH     TAC,1-TSHF              ;SHIFT TO MAKE INDEX
1767:         SUBI    TAC,2                   ;NORMALIZE TO ZERO INDEX
1768:         CAILE   TAC,2*NFSB-2            ;ARE WE AT THE END OF THE TABLE?
1769:         JRST    FSGTBX                  ;YES. LOOK FOR A BIG BLOCK
1770:         LSH     TAC,-1
1771:         AOS     FSRPQ(TAC)
1772:         LSH     TAC,1
1773: FSGT0:  MOVE    TAC1,TAC                ;INDEX TO FIRST BASE INSPECTED
1774:         MOVE    BLOCK,MEMSIZ            ;FIND BLOCK WITH A HIGHER ADDRESS
1775: FSGT1:  CAMGE   BLOCK,FSAVB+1(TAC1)     ;ADDRESS BIGGER THAN OUR BEST?
1776:         MOVE    BLOCK,FSAVB+1(TAC1)     ;YES. REMEBER BEST ADDRESS
1777:         ADDI    TAC1,2                  ;GO ON TO NEXT LIST BASE
1778:         AOS     NFSLP1                  ;COUNT A LOOP OF TYPE1
1779:         CAIGE   TAC1,2*NFSB             ;STILL IN TABLE?
1780:         JRST    FSGT1                   ;YES. LOOP
1781:         CAMG    BLOCK,MEMSIZ            ;FOUND ANY?
1782:         JRST    FSGTW                   ;NO WE'LL HAVE TO WAIT...
1783:         PUSHJ   P,FSGCL                 ;CALL ROUTINE TO CLAIM AND DELINK
1784:         JRST    FSGT0                   ;THE CLAIM FAILED. LOOK AGAIN.
1785:         JRST    FSGTC                   ;CLAIM OK
1786: 
1787: FSGTBX: AOS     FSRPQ+NFSB-1
1788: FSGTB0: HRRZ    BLOCK,FSAVB+2*NFSB-1    ;GET THE FIRST LINK
1789: FSGTB1: AOS     NFSLP2                  ;COUNT A LOOP OF TYPE 2
1790:         CAIG    BLOCK,FSAVB+2*NFSB-1    ;FLINK > ADDRESS OF LIST BASE?
1791:         JRST    FSGTW                   ;NO. WE'LL HAVE TO WAIT.
1792:         SKIPG   AC2,(BLOCK)             ;SKIP IF THIS BLOCK IS NOT CLAIMED
1793:         JRST    FSGTB0                  ;HIGHER CHANNEL MUST HAVE GOT THIS ONE!
1794:         HLRZ    TAC1,AC2                ;GET THE SIZE FIELD
1795:         CAIL    TAC1,(SIZE)             ;SIZE BIG ENOUGH?
1796:         JRST    FSGTB2                  ;YES. TRY TO CLAIM IT
1797:         MOVEI   BLOCK,(AC2)             ;LOAD NEXT FLINK
1798:         JRST    FSGTB1                  ;LOOP
1799: 
1800: FSGTB2: PUSHJ   P,FSGCL                 ;CLAIM THE BLOCK AND DELINK IT
1801:         JRST    FSGTB0                  ;CLAIM FAILED.
1802:         JRST    FSGTC                   ;GOT IT
1803: 
1804: FSGCL:  CONI    PI,AC2                  ;GET PI CHANNEL STATUS
1805:         ANDI    AC2,PICMSK              ;ONLY CHANNELS 3,4,5,6,7
1806:         CONO    PI,PICHOF(AC2)          ;TURN OFF CHANNELS 3-7
1807:         SKIPG   TAC1,(BLOCK)            ;FLINK INTO TAC1
1808:         JRST    FSGCLX                  ;BLOCK IS ALREADY CLAIMED!
1809:         HRRZ    TAC,-1(BLOCK)           ;BLINK INTO TAC
1810:         HRRM    TAC1,(TAC)              ;GO BACK AND RESET FLINK
1811:         HRRM    TAC,-1(TAC1)            ;GO FORWARD AND RESET BLINK
1812:         CONO    PI,PICHON(AC2)          ;RESTORE CHANNELS THAT WERE ON
1813:         MOVSI   AC2,400000
1814:         IORM    AC2,(BLOCK)             ;TURN ON THE SIGN BIT TO CLAIM BLOCK
1815:         JRST    CPOPJ1                  ;GIVE THE SKIP RETURN
1816: 
1817: FSGCLX: CONO    PI,PICHON(AC2)          ;RESTORE PI.
1818:         POPJ    P,
1819: 
1820: FSGTC:  LDB     AC2,FSSBYP              ;GET THE SIZE OF THIS BLOCK
1821:         SETZ    TEM,                    ;INITIALIZE EXCESS SIZE
1822:         CAIGE   AC2,TRIVIAL(SIZE)       ;IS BLOCK TOO BIG?
1823:         JRST    FSGTC1                  ;NO
1824:         MOVE    TEM,AC2                 ;GET THE SIZE
1825:         SUBI    TEM,(SIZE)              ;GET EXCESS SIZE
1826:         MOVEI   AC2,(SIZE)              ;GET THE SIZE TO USE
1827:         DPB     AC2,FSSBYP              ;SET SIZE
1828: FSGTC1: HLLZS   (BLOCK)                 ;CLEAR RIGHT SIDE OF TOP MARK
1829:         SUBM    BLOCK,AC2               ;AC2 GETS ADDRESS BELOW LOWEST
1830:         HRROM   BLOCK,1(AC2)            ;SET UP POINTER IN THE LOW ADDRESS
1831:         JUMPE   TEM,FSGTCR              ;ALL DONE IF NO SPLIT
1832:         HRLZM   TEM,(AC2)               ;SET SIZE IN SPLIT BLOCK
1833:         SUBM    AC2,TEM                 ;GET LOWEST ADDRESS OF THIS, -1
1834:         HRRZM   AC2,1(TEM)              ;SET UP FORWARD LINK
1835:         HLRZ    TEM,(AC2)               ;GET THE SIZE BACK
1836:         CAIGE   TEM,NFSB*TRIVIAL        ;IS BLOCK VERY BIG?
1837:         JRST    FSGTC4                  ;NO. RETURN THE SPLIT BY THE CLOCK
1838:         JRST    FSGTC5
1839: FSGTC2: CONO    PI,PICHON(TEM)          ;TURN CHANNELS ON AGAIN
1840: FSGTC5: SKIPG   (TAC1)                  ;LOOK AHEAD
1841:         JRST    FSGTC6                  ;LOSE
1842:         MOVE    DAT,-1(TAC1)            ;GET BLINK AHEAD
1843:         HRRM    DAT,-1(AC2)             ;SET BLINK HERE
1844:         HRRM    TAC1,(AC2)              ;SET FLINK HERE
1845:         CONI    PI,TEM                  ;GET PI STATUS
1846:         ANDI    TEM,PICMSK
1847:         CONO    PI,PICHOF(TEM)          ;TURN OFF CHANNELS
1848:         SKIPLE  (TAC1)                  ;GRABBED FROM UNDER US?
1849:         CAME    DAT,-1(TAC1)            ;BE SURE
1850:         JRST    FSGTC2                  ;TRY AGAIN
1851:         HRRM    AC2,-1(TAC1)            ;SET BLINK AHEAD
1852:         HRRM    AC2,(DAT)               ;SET FLINK BEHIND
1853:         CONO    PI,PICHON(TEM)          ;TURN ON PI'S AGAIN
1854:         JRST    FSGTCR                  ;RETURN FREE STORAGE.
1855: 
1856: FSGTC3: CONO    PI,PICHON(TEM)
1857: FSGTC6: SKIPG   DAT,(TAC)
1858:         JRST    FSGTC4                  ;LINK'S HAVE MOVED
1859:         HRRM    DAT,(AC2)               ;SET FLINK HERE
1860:         HRRM    TAC,-1(AC2)             ;SET BLINK HERE
1861:         CONI    PI,TEM
1862:         ANDI    TEM,PICMSK
1863:         CONO    PI,PICHOF(TEM)
1864:         CAME    DAT,(TAC)               ;THESE GUYS STILL THE SAME?
1865:         JRST    FSGTC3                  ;LINKS HAVE MOVED. TRY AGAIN
1866:         HRRM    AC2,-1(DAT)             ;SET BLINK AHEAD
1867:         HRRM    AC2,(TAC)               ;SET FLINK BEHIND
1868:         CONO    PI,PICHON(TEM)
1869:         JRST    FSGTCR                  ;RETURN BLOCK
1870: 
1871: FSGTC4: MOVSI   TAC,400000
1872:         IORM    TAC,(AC2)
1873:         LDB     TAC,FSSBP1
1874:         SUBM    AC2,TAC
1875:         HRROM   AC2,1(TAC)
1876:         PUSH    P,BLOCK
1877:         MOVEI   BLOCK,2(TAC)
1878:         PUSHJ   P,FSQUIK                ;ADD BLOCK TO FSRTL.
1879:         POP     P,BLOCK
1880: FSGTCR: LDB     TAC,FSSBYP              ;GET THE SIZE
1881:         ADDM    TAC,FSBUSY              ;ADD TO CLAIMED AMOUNT.
1882:         SUBI    BLOCK,-2(TAC)           ;COMPUTE LOWEST USABLE ADDRESS
1883:         CONSO   PI,77000                ;SKIP IF AT HI PI CHANNEL
1884:         SKIPN   FSRTL                   ;LOW CHANNEL. SKIP IF ANY COMING BACK
1885:         JRST    FSGRT1                  ;NOTHING TO DO OR MUST RETURN QUICK
1886:         PUSH    P,BLOCK
1887:         PUSHJ   P,FSCKX                 ;GIVE IT BACK TO THE INDIANS
1888:         POP     P,BLOCK
1889: FSGRT1: XSYNC   FSCSC
1890:         JSP     DAT,FSACRS
1891:         PUSH    P,[FSGET]               ;IN CASE OF TROUBLE TRY AGAIN
1892:         PUSHJ   P,FSECHK
1893:         POP     P,(P)                   ;FLUSH STACK
1894:         JRST    CPOPJ1                  ;AND GIVE SKIP RETURN
1895: 
1896: ;HERE IF WE COULDN'T FIND ANY FREE STORAGE.
1897: FSGTW:  PUSHJ   P,FSGETK                ;WE NEED ANOTHER K, GET IT
1898:         JRST    FSGTW5                  ;CAN'T GET ANOTHER K
1899:         PUSHJ   P,FSWAKE                ;WAKE SOMEONE WHO WAITS
1900:         JRST    FSGETT                  ;FSGET RETRY THIS ONE
1901: 
1902: FSGTW5: CONSO   PI,77400                ;ARE WE AT I-LEVEL?
1903:         SKIPE   FSGTUF                  ;NOT I-LEVEL, WANT TO RETURN QUICK?
1904:         JRST    FSGFAI                  ;GIVE THE NON-SKIP RETURN
1905:         SKIPE   INTACT(PID)             ;IF YOU'RE AT USER I-LEVEL YOU'LL
1906:         JRST    WSCHED                  ;BE KICKED OUT BY WSCHED....
1907:         AOS     NFSWAITS                ;COUNT A WAIT
1908:         PUSH    P,J                     ;SAVE J ON THE STACK
1909:         MOVE    J,JOB(PID)              ;GET THE JOB NUMBER
1910:         HRL     J,SIZE                  ;GET THE SIZE OF REQUEST
1911:         MOVEM   J,@FSIPTR               ;SAVE IN OUR QUEUE OF JOBS
1912:         AOS     TAC,FSIPTR              ;INCREMENT THE POINTER
1913:         CAIL    TAC,FSLIST+JOBN
1914:         MOVEI   TAC,FSLIST
1915:         MOVEM   TAC,FSIPTR
1916:         AOS     FSCNT
1917:         XSYNC   FSCSC
1918:         PUSHJ   P,WSCHED                ;CALL CH7 TO RESCHEDULE JOB(PID)
1919:         SETZM   FSGTUF                  ;ZERO THIS CELL SO IF WE FAIL AGAIN, WE WAIT
1920:         PSYNC   FSCSC                   ;HERE EVENTUALLY AFTER FSWAKE
1921:         PUSHJ   P,FSWAKE                ;WAKE SOMEONE ELSE
1922:         POP     P,J                     ;RESTORE J, FINALLY.
1923:         JRST    FSGETT                  ;PLAY IT AGAIN, SAM.
1924: 
1925: FSGFAI: XSYNC   FSCSC
1926:         JSP     DAT,FSACRS              ;RESTORE AC'S
1927:         AOS     NFSGFA                  ;COUNT A FAILURE
1928:         POPJ    P,                      ;CRY
1929: 
1930: FSGLUZ: HRRZ    BLOCK,(P)               ;GET RETURN ADDRESS
1931:         PUSHACS
1932:         PUSHJ   P,DISERR
1933:         [ASCIZ/ FSGET CALLED ILLEGALLY FROM PI CHANNEL 1 OR 2
1934: RETURN ADDRESS = /]
1935:         DISARG ( LOC,<BLOCK-20(P)> )
1936:         [ASCIZ/
1937: /]
1938:         -1
1939:         POPACS
1940:         JUMPE   PID,CPOPJ
1941:         HALT    CPOPJ                   ;STOP THE PDP-6
    CORE page# 0023 next  prev
1943: ;SWIPE 1K FROM AVAILABLE USER SPACE.
1944: ;THIS CAN BE DONE ONLY AT CLOCK OR UUO LEVEL.
1945: ;IT SETS THE FOLLOWING GLOBAL VALUES:
1946: ; CORLST                BYTE POINTER SET TO THE SECOND UNAVAILABLE 1K BLOCK.
1947: ; CORTAL                NUMBER OF 1K BLOCKS AVAILABLE TO USERS
1948: ; CORMAX                MAXIMUM NUMBER OF WORDS A JOB MAY HAVE.
1949: ; MEMSIZ                LOWEST LOCATION USED BY FREE STORAGE
1950: 
1951: FSGETK: JUMPN   PID,CPOPJ               ;THE PDP-6 CAN'T DO THIS
1952:         CONSZ   PI,77000                ;ARE WE AT A HIGH CHANNEL?
1953:         POPJ    P,                      ;YES. WE CAN'T DO THIS!
1954:         PUSH    P,LOC
1955:         MOVE    LOC,MEMSIZ              ;GET THE CURRENT MEMORY SIZE
1956:         SUBI    LOC,2000                ;GET LOWEST ADDRESS WE WANT
1957:         PUSHJ   P,CORGBP                ;MAKE A BYTE POINTER TO CORTAB
1958:         POP     P,LOC
1959:         ILDB    TAC1,TAC                ;PICK UP MARK BIT FOR THIS BLOCK
1960:         JUMPN   TAC1,FSSWAP             ;JUMP IF CLAIMED AND FORCE USER OUT
1961:         MOVEI   TAC1,105                ;CLAIM THIS BLOCK!
1962:         DPB     TAC1,TAC                ;STUFF OUR CLAIM BIT IN
1963:         IBP     TAC
1964:         MOVEM   TAC,CORLST              ;SECOND UNAVAILABLE BYTE IN CORTAB
1965:         MOVNI   TAC,2000                ;UPDATE 4 GLOBAL CELLS
1966: IFN FTSWAP,<
1967:         ADDM    TAC,CORMAX >            ;MAXIMUM CORE SIZE IN WORDS
1968:         ADDM    TAC,MEMSIZ              ;BOTTOM OF FREE STORAGE
1969:         SOS     CORTAL                  ;NUMBER OF 1K BLOCKS FOR USERS
1970: IFN FTCORBUG,<  PUSHJ   P,CORCHK >      ;CHECK VALIDITY OF CORE TABLES.
1971:         PUSH    P,LOC
1972:         PUSH    P,UCHN
1973:         PSYNC   CORCSC
1974:         PUSHJ   P,DIDLE4                ;SET UP HOLEF, BIGHOL, AND SKIP RETURN
1975:         JFCL                            ;ALWAYS SKIP RETURNS
1976:         POP     P,UCHN
1977:         POP     P,LOC
1978:         MOVE    BLOCK,MEMSIZ            ;GET THE LOW BOUND OF FS.
1979:         ADDI    BLOCK,1777              ;POINTER TO HIGH SIDE OF THIS 1K
1980:         MOVSI   TAC,402000              ;SET UP SIZE AND USE BIT
1981:         MOVEM   TAC,(BLOCK)             ;STUFF IN BLOCK HEADER
1982:         HRROM   BLOCK,@MEMSIZ           ;STUFF IN LOWER MARKER
1983:         MOVE    BLOCK,MEMSIZ
1984:         ADDI    BLOCK,1
1985:         PUSH    P,SIZE
1986:         PUSHJ   P,FSGIVX                ;GIVE BACK A 1K BLOCK (MERGES)
1987:         POP     P,SIZE
1988:         SETZM   FSGVKF                  ;FLUSH WARNING ABOUT BOTTOM K.
1989:         JRST    CPOPJ1                  ;GIVE A SKIP RETURN FROM FSGETK
1990: 
1991: ;ROUTINE TO FORCE THE JOB AT TOP OF CORE OUT.
1992: 
1993: FSSWAP:
1994: IFN FTSWAP,<
1995:         SKIPN   FORCE                   ;CAN WE DIDDLE THE SWAPPER NOW?
1996:         SKIPE   FINISH                  ;?
1997:         JRST    FSSWP3                  ;NO CAN'T BOTHER HIM JUST YET.
1998:         PUSH    P,LOC                   ;SAVE LOC FOR A WHILE
1999:         MOVE    LOC,MEMSIZ              ;REMOVE 4 INSTRUCTIONS STARTING HERE.
2000:         SUBI    LOC,2000                        ;D.RED.D.
2001:         PUSHJ   P,CORGBP
2002:         POP     P,LOC
2003:         PUSH    P,J                     ;DON'T CLOBBER J
2004:         ILDB    J,TAC                   ;GET JOB NUMBER OF THE GUY TO FORCE
2005:         MOVE    TAC,JBTSTS(J)
2006:         TLNE    TAC,SWP!SHF             ;IS HE IN MOTION?
2007:         JRST    FSWP3A                  ;CAN'T DO HIM NOW.
2008:         HLRZ    TAC,JBTADR(J)
2009:         SKIPN   XJOB(J)
2010:         PUSHJ   P,XPAND                 ;MAKE HIM GET SHOVED OUT
2011: FSWP3A: POP     P,J                     ;RESTORE J
2012: >
2013: FSSWP3: SETOM   FSCLKF                  ;TELL FSCLK TO THINK ABOUT GOBBLING
2014:         SETOM   FSNCLK                  ;TELL CLKSER TO RUN FSCLK
2015:         POPJ    P,                      ;AND RETURN
2016: 
2017: 
2018: ; THIS ROUTINE REQUEUES A JOB WHEN CORE IS AVAILABLE FOR HIM.
2019: 
2020: FSWAKE: CONO    PI,PIOFF
2021:         SKIPLE  FSCNT                   ;ANYONE THERE?
2022:         JRST    FSWAK1                  ;YES
2023:         SETZM   FSCNT
2024:         CONO    PI,PION
2025:         POPJ    P,                      ;NO WORK FOR NO ONE
2026: 
2027: FSWAK1: SOS     FSCNT                   ;DECREASE NUMBER OF WAITERS
2028:         CONO    PI,PION
2029:         HRRZ    J,@FSOPTR               ;GET JOB NUMBER TO REQUEUE
2030:         AOS     TAC,FSOPTR
2031:         CAIL    TAC,FSLIST+JOBN
2032:         MOVEI   TAC,FSLIST
2033:         MOVEM   TAC,FSOPTR
2034:         SKIPL   JBTSTS(J)               ;IS THIS GUY STILL RUNABLE?
2035:         JRST    FSWAKE                  ;NO. TRY ANOTHER ONE.
2036:         MOVNI   TAC,RUNQ
2037:         MOVEM   TAC,JOBQUE(J)           ;SET QUEUE FOR THIS JOB
2038:         JRST    REQUE                   ;REQUEUE THIS JOB
    CORE page# 0024 next  prev
2040: COMMENT $FSCLK: CLOCK LEVEL (CHANNEL 7) ROUTINES TO KEEP FREE STORAGE HAPPY!
2041: CALLED FROM CLKSER, NEAR CALL ON DPYCLK
2042: $
2043: 
2044: ↑FSCLK: SETZM   FSNCLK                  ;WE HAVE GOTTEN SERVICE. SHUT OFF FLAG.
2045:         PSYNC   FSCSC                   ;SYNCRONIZE
2046:         PUSHJ   P,FSCKX                 ;RETURN CONTENTS OF FSRTL.
2047: FSCKY:  SKIPN   FSCLKF                  ;ARE WE WAITING FOR THE SWAPPER?
2048:         JRST    FSCLK1                  ;NO. SKIP THIS MESS
2049:         SETZM   FSCLKF
2050:         PUSHJ   P,FSGETK                ;LOOK FOR THE 1K WE WANTED.
2051:         JRST    FSCKZ                   ;THERE WASN'T ANY THERE FOR US
2052:         PUSHJ   P,FSWAKE                ;ATTEMPT TO WAKE A WAITER.
2053:         JRST    FSCKZ                   ;AVOID ATTEMP TO GIVE BACK 1K
2054: 
2055: FSCLK1: SKIPN   FSGVKF                  ;MAYBE THERE'S A 1K BLOCK TO GIVE BACK?
2056:         JRST    FSCKZ                   ;NOPE.
2057:         SETZM   FSGVKF
2058:         HRRZ    BLOCK,@MEMSIZ           ;POINTER TO TOP OF BOTTOM BLOCK
2059:         LDB     SIZE,FSSBYP             ;GET THE SIZE FIELD
2060:         CAIGE   SIZE,2000               ;SKIP IF BIG ENOUGH
2061:         JRST    FSCKZ
2062:         PUSHJ   P,FSGCL                 ;ATTEMPT TO CLAIM THIS BLOCK
2063:         JRST    FSCKZ                   ;LOSE
2064:         LDB     SIZE,FSSBYP             ;GET THE SIZE
2065:         MOVEI   TEM,(BLOCK)             ;GET THE BLOCK ADDRESS
2066:         SUBI    TEM,-1(SIZE)            ;GET THE BOTTOM ADDRESS
2067:         HRROM   BLOCK,(TEM)             ;CLAIM THE BOTTOM
2068:         CAIL    SIZE,2000               ;SKIP IF SMALLER THAN A BREADBOX
2069:         CAME    TEM,MEMSIZ              ;BIG ENOUGH. AT BOTTOM?
2070:         JRST    FSGVK3                  ;NO. GIVE IT ALL BACK.
2071:         SUBI    SIZE,2000               ;FIGURE SIZE OF NEW BLOCK
2072:         JUMPE   SIZE,FSGVK1             ;THERE'S NOTHING TO SPLIT
2073:         DPB     SIZE,FSSBYP             ;SET SIZE FIELD IN BLOCK
2074:         SUBM    BLOCK,SIZE              ;GET THE BOTTOM ADDRESS
2075:         HRROM   BLOCK,1(SIZE)           ;SET THE BOTTOM MARK
2076:         MOVEI   BLOCK,2(SIZE)           ;GET THE ADDRESS FOR FSGIVE
2077:         SETOM   (SIZE)                  ;MAKE HI END OF K LOOK CLAIMED.
2078:         PUSHJ   P,FSGIVX                ;GIVE BACK THIS PART OF THE BLOCK
2079: FSGVK1: MOVEI   TAC,2000
2080:         ADDM    TAC,MEMSIZ
2081: IFN FTSWAP,<
2082:         ADDM    TAC,CORMAX>
2083:         AOS     CORTAL
2084:         MOVE    LOC,MEMSIZ
2085:         SUBI    LOC,2000
2086:         PUSHJ   P,CORGBP
2087:         SETZ    TAC1,
2088:         IDPB    TAC1,TAC
2089:         IBP     TAC
2090:         MOVEM   TAC,CORLST
2091: IFN FTCORBUG,<  PUSHJ   P,CORCHK  >     ;MAKE SURE CORTAB AND CORTAL ARE CONSISTENT
2092:         PSYNC   CORCSC
2093:         PUSHJ   P,DIDLE4
2094:         JFCL
2095:         SETOM   FSGVKF                  ;FLAG FOR NEXT TICK JUST IN CASE 
2096:         JRST    FSCKZ
2097: 
2098: FSGVK3: MOVEI   BLOCK,1(TEM)            ;GET THE BOTTOM DATA WORD ADDRESS
2099:         PUSHJ   P,FSGIVX                ;GIVE BACK THIS BLOCK!
2100: FSCKZ:  SKIPLE  FSCKCT                  ;TIME TO DO CHECKERBOARD?
2101:         JRST    FSCLK3                  ;NO.
2102:         MOVE    BLOCK,RMEMSIZ
2103:         SUB     BLOCK,MEMSIZ
2104:         SUB     BLOCK,FSBUSY
2105:         CAILE   BLOCK,5000              ;SKIP IF LESS THAN 2.5 FREE
2106:         JRST    FSCLK4                  ;TOO MUCH IS FREE.
2107:         MOVEI   BLOCK,=30*JIFSEC        ;LOOK AGAIN IN 30 SECONDS.
2108:         MOVEM   BLOCK,FSCKCT
2109: FSCLK3: XSYNC   FSCSC
2110:         POPJ    P,
2111: 
2112: FSCLK4: XSYNC   FSCSC
2113:         MOVEI   BLOCK,=10*JIFSEC
2114:         MOVEM   BLOCK,FSCKCT
2115:         JRST    RELEX                   ;RELEASE SPARES.
2116: 
2117: 
2118: FSCKX:  SKIPN   FSRTL                   ;ANY ONE ON THE RETURN LIST?
2119:         POPJ    P,                      ;NO. RETURN
2120:         CONO    PI,PIOFF                ;DON'T INTERRUPT
2121:         HRRZ    BLOCK,FSRTL             ;GET THE FORWARD LINK
2122:         MOVE    TAC,(BLOCK)             ;GET THE NEXT FLINK
2123:         HRRZM   TAC,FSRTL               ;SAVE IT HERE
2124:         CONO    PI,PION                 ;TURN ON THE PI'S
2125:         LDB     TAC,FSSBYP              ;GET THE SIZE FIELD
2126:         SUBI    BLOCK,-2(TAC)           ;GET THE ADDRESS OF LOWEST DATA WORD
2127:         PUSHJ   P,FSGIVX                ;ALL SET TO GIVE THE BLOCK BACK AGAIN
2128:         JRST    FSCKX                   ;LOOK FOR MORE
    CORE page# 0025 next  prev
2130: COMMENT $       FSGIVE: RETURN FREE STORAGE TO SYSTEM.
2131: CALLING:
2132:         MOVE    BLOCK,<ADDRESS OF BLOCK>
2133:         PUSHJ   P,FSGIVE
2134:         <RETURN HERE ALWAYS>
2135: 
2136: FSGIVX IS ROUTINE FOR FSGIVE THAT DOESN'T SAVE AC'S 
2137: USE THIS ONLY INSIDE OF FS ROUTINES!
2138: 
2139: $
2140: 
2141: FSECHK: PUSH    P,BLOCK         ;SAVE AC'S FOR A WHILE.
2142:         PUSH    P,SIZE          ;SAVE.
2143:         CAMGE   BLOCK,RMEMSIZ
2144:         CAMG    BLOCK,MEMSIZ
2145:         JRST    FSECK1
2146:         SUBI    BLOCK,1
2147:         TRNE    BLOCK,TRIVIAL-1 ;ALL THESE BITS MUST BE OFF!
2148:         JRST    FSECK1
2149:         HRRZ    BLOCK,(BLOCK)   ;GET BOTTOM LINK
2150:         CAMGE   BLOCK,RMEMSIZ
2151:         CAMG    BLOCK,MEMSIZ
2152:         JRST    FSECK1
2153:         HLRZ    SIZE,(BLOCK)    ;GET 400000+SIZE
2154:         SUBI    BLOCK,-400002(SIZE)     ;MAKE POINTER TO 1 ABOVE LOWEST ADR.
2155:         CAME    BLOCK,-1(P)             ;MAKE SURE THESE ARE THE SAME.
2156:         JRST    FSECK1          ;LOSE
2157:         POP     P,SIZE
2158:         POP     P,BLOCK
2159:         POPJ    P,
2160: 
2161: FSECK1: 
2162:         PUSHACS 
2163:         PUSHJ   P,DISMES
2164:         ASCIZ   /RELEASE OF NON-EX FREE STORAGE BLOCK. BLOCK = /
2165:         MOVE    TAC,-21(P)      ;REACH BACK AND PULL UP STINKING MESS.
2166:         PUSHJ   P,DISLOC
2167:         PUSHJ   P,DISMES
2168:         ASCIZ   /
2169: CALLERS ADDRESS = /
2170:         MOVE    TAC,-23(P)
2171:         PUSHJ   P,DISLOC
2172:         PUSHJ   P,DISMES
2173:         ASCIZ   /
2174: 
2175: /
2176:         SKIPE   DEBMOD                  ;NO NEED TO DISFLUSH IF NOT DEBUGGING
2177:         PUSHJ   P,DISFLUSH              ;MAKE SURE WE CAN SEE MESSAGE.
2178:         POPACS
2179:         DEBCHECK
2180:         POP     P,SIZE
2181:         POP     P,BLOCK
2182:         POP     P,(P)           ;THROW OUT RETURN FROM FSCHEK
2183:         POPJ    P,              ;RETURN TO BASTARD WHO CALLED ME.
2184: 
2185: ↑FSGIVE:MOVEI BLOCK,(BLOCK)             ;SOME PEOPLE COME HERE WITH SHIT IN LEFT HALF
2186:         PUSHJ   P,FSECHK                ;CHECK FOR WINNING ADDRESSES
2187:         AOS     NFSGIVES                ;INCREMENT COUNT OF GIVES
2188:         PUSH    P,BLOCK                 ;SAVE THIS FOR A WHILE.
2189:         HRRZ    BLOCK,-1(BLOCK)         ;GET THE TOP ADDRESS
2190:         LDB     BLOCK,FSSBYP            ;GET THE SIZE
2191:         MOVN    BLOCK,BLOCK             ;GET -SIZE
2192:         ADDM    BLOCK,FSBUSY            ;DECREASE BUSY COUNT
2193:         POP     P,BLOCK                 ;RESTORE BLOCK.
2194:         CONSZ   PI,77000                ;SKIP IF WE'RE NOT IN CHANNELS 1-6
2195:         JRST    FSQUK1                  ;DO THE QUICK STUFF!
2196:         PUSHJ   P,FSACSV                ;SAVE AC'S
2197:         PUSHJ   P,FSGIVY                ;NOW GO GIVE BACK FREE STORAGE
2198:         JSP     DAT,FSACRS              ;RESTORE AC'S
2199:         POPJ    P,                      ;RETURN
2200: 
2201: FSGIVX: PUSHJ   P,FSECHK                ;CHECK FOR ERROR.
2202:         CONSZ   PI,77000                ;SKIP IF AT LOW LEVEL
2203:         JRST    FSQUK1                  ;AT HI CHANNEL GIVE BACK QUICK
2204: FSGIVY: PUSH    P,BLOCK                 ;SAVE BLOCK
2205:         PSYNC   FSCSC                   ;LOCK OUT OTHER PROCESSOR
2206:         MOVEI   AC2,-2(BLOCK)           ;AC2 ← HIGH ADDRESS OF LOWER BLOCK
2207:         HRRZ    BLOCK,1(AC2)            ;BLOCK SET TO TOP WORD OF THIS BLOCK
2208:         CAMG    AC2,MEMSIZ              ;NO MERGE IF WE'RE AT THE BOTTOM
2209:         JRST    FSGV1                   ;NO. TRY A HIGH MERGE.
2210:         PUSH    P,BLOCK                 ;SAVE BLOCK TOP!
2211:         MOVE    BLOCK,AC2               ;GET THE ADDRESS OF LOWER
2212:         PUSHJ   P,FSGCL                 ;ATTEMPT TO CLAIM LOWER
2213:         JRST    FSGV0                   ;POP BLOCK AND FORGET ABOUT LOW MERGE
2214:         LDB     TEM,FSSBYP              ;GET THE SIZE
2215:         MOVEI   DAT,(BLOCK)
2216:         SUBI    DAT,(TEM)               ;GET THE BOTTOM ADDRESS - 1
2217:         POP     P,BLOCK                 ;GET ADDRESS OF TOP OF BIG BLOCK
2218:         LDB     TAC1,FSSBYP             ;GET SIZE OF ORIGINAL
2219:         ADD     TEM,TAC1                ;SUM THEM
2220:         DPB     TEM,FSSBYP              ;STUFF THEM IN THE ORIGINAL
2221:         HRROM   BLOCK,1(DAT)            ;SAVE A BOUNDARY MARKER.
2222:         JRST    FSGV1
2223: FSGV0:  POP     P,BLOCK                 ;GET THE TOP OF THIS BLOCK BACK.
2224: FSGV1:  MOVEI   TAC1,1(BLOCK)           ;GET ADDRESS OF GUY ABOVE
2225:         JUMPE   TAC1,FSGV2A             ;MOVEI OVERFLOW IF BLOCK=777777.
2226:         CAML    TAC1,RMEMSIZ            ;SKIP IF NOT THE TOP OF ALL CORE
2227:         JRST    FSGV2A                  ;THIS BLOCK IS AT THE VERY TOP!
2228:         HRRZ    TAC1,1(BLOCK)           ;GET BOTTOM POINTER OF GUY ABOVE
2229:         CONI    PI,DAT
2230:         ANDI    DAT,PICMSK
2231:         CONO    PI,PICHOF(DAT)          ;STOP CHANNELS 3-7
2232:         HRRZ    AC2,1(BLOCK)            ;GET THE BOTTOM POINTER
2233:         SKIPG   TAC,(AC2)               ;GET THE FLINK
2234:         JRST    FSGV2                   ;ALL A BAD IDEA.
2235:         MOVE    TAC1,-1(AC2)            ;GET THE BLINK
2236:         HRRM    TAC1,-1(TAC)            ;GO FORWARD AND STUFF BLINK
2237:         HRRM    TAC,(TAC1)              ;GO BACK AND SET FLINK
2238:         CONO    PI,PICHON(DAT)          ;ALLOW INTERRUPTS AGAIN
2239:         MOVSI   DAT,400000
2240:         IORM    DAT,(AC2)               ;CLAIM THIS BLOCK.
2241:         LDB     TAC,FSSBP1              ;GET THE SIZE OF THIS GUY
2242:         LDB     SIZE,FSSBYP
2243:         ADD     SIZE,TAC
2244:         MOVE    DAT,AC2
2245:         SUB     DAT,SIZE                ;COMPUTE THE BOTTOM ADDRESS
2246:         DPB     SIZE,FSSBP1
2247:         HRROM   AC2,1(DAT)
2248:         SKIPA   BLOCK,AC2
2249: FSGV2:  CONO    PI,PICHON(DAT)
2250: FSGV2A: LDB     SIZE,FSSBYP
2251:         LSH     SIZE,1-TSHF             ;SHIFT SIZE TO MAKE INDEX.
2252:         SUBI    SIZE,2                  ;FIX INDEX.
2253:         CAIL    SIZE,NFSB*2             ;REASONABLE INDEX?
2254:         MOVEI   SIZE,NFSB*2-2           ;NO. FIX INDEX.
2255:         JRST    FSGV6
2256: FSGV5:  CONO    PI,PICHON(TAC1)         ;MAKE SURE PI'S GET RESTORED
2257: FSGV6:  MOVEI   TAC,FSAVB+1(SIZE)       ;GET THE LIST BASE
2258: FSGV7:  SKIPG   DAT,(TAC)               ;DOES THIS POINT FREE?
2259:         JRST    FSGV6                   ;NO TRY THIS LIST ALL OVER AGAIN
2260:         HRRZ    TEM,(TAC)               ;GET THE FLINK
2261:         CAIGE   TEM,(BLOCK)             ;HAVE WE FOUND THE RIGHT PLACE?
2262:         JRST    FSGV8                   ;YES. PREPARE TO LINK IT IN
2263:         CAME    DAT,(TAC)               ;IS THIS STILL THE SAME?
2264:         JRST    FSGV6                   ;NO. TRY ALL OVER
2265:         MOVEI   TAC,(TEM)               ;GET THE NEXT FLINK
2266:         JRST    FSGV7                   ;CHASE DOWN THIS LIST
2267: 
2268: FSGV8:  HRRZM   TAC,-1(BLOCK)           ;SET THE BLINK
2269:         HRRM    TEM,(BLOCK)             ;SET THE FLINK
2270:         LDB     AC2,FSSBYP              ;GET THE SIZE OF BLOCK
2271:         SUBM    BLOCK,AC2               ;GET POINTER TO BOTTOM
2272:         MOVSI   SIZE,400000
2273:         ANDCAM  SIZE,(BLOCK)            ;TURN OFF CLAIM BIT
2274:         CONI    PI,TAC1
2275:         ANDI    TAC1,PICMSK
2276:         CONO    PI,PICHOF(TAC1)         ;HOLD CHANNELS 3-7
2277:         CAME    DAT,(TAC)               ;STILL HERE?
2278:         JRST    FSGV5                   ;WHAT A LOSS.
2279:         HRRM    BLOCK,(TAC)             ;STUFF IN NEW FLINK
2280:         HRRM    BLOCK,-1(TEM)           ;STUFF IN NEW BLINK
2281:         HRRZM   BLOCK,1(AC2)            ;AND TURN OFF BOTTOM MARK
2282:         CONO    PI,PICHON(TAC1)         ;ALLOW INTERRUPTS
2283:         HRRZ    BLOCK,@MEMSIZ           ;POINTER TO BOTTOM-MOST FS BLOCK
2284:         LDB     SIZE,FSSBYP             ;GET THE SIZE OF LOW BLOCK
2285:         SKIPL   (BLOCK)                 ;SKIP IF BLOCK IS CLAIMED ALREADY
2286:         CAIGE   SIZE,2000               ;UNCLAIMED. SKIP IF BIGGER THAN 1K
2287:         JRST    FSXPOP                  ;CLAIMED OR NOT BIG ENOUGH
2288:         SKIPN   FSCNT                   ;SKIP IF ANYONE'S WAITING
2289:         SETOM   FSGVKF                  ;SET FLAG TO LET CLOCK THINK ABOUT IT
2290:         SETOM   FSNCLK                  ;MAKE CLKSER CALL FSCLK
2291: FSXPOP: PUSH    P,J                     ;SAVE J, CLOBBERED BY FSWAKE
2292:         PUSHJ   P,FSWAKE                ;WAKE SOMEONE WHO WAITS.
2293:         POP     P,J                     ;RESTORE J
2294: FSPOP:  POP     P,BLOCK
2295:         XSYNC   FSCSC
2296:         POPJ    P,
2297: 
2298: 
2299: FSQUIK: PUSHJ   P,FSECHK                ;CHECK ADDRESSES
2300: FSQUK1: PUSH    P,BLOCK
2301:         PUSH    P,TEM
2302:         HRRZ    BLOCK,-1(BLOCK)         ;LOAD TOP ADDRESS FROM BOTTOM
2303:         PSYNC   FSCSC
2304:         CONO    PI,PIOFF                ;ADD THIS BLOCK TO THE FREE LIST
2305:         HRRZ    TEM,FSRTL               ;GET THE FLINK
2306:         HRRM    TEM,(BLOCK)             ;SAVE HERE
2307:         HRRZM   BLOCK,FSRTL             ;RESET LIST BASE
2308:         CONO    PI,PION                 ;DONE
2309:         SETOM   FSNCLK
2310:         POP     P,TEM
2311:         JRST    FSPOP
    CORE page# 0026 next  prev
2313: ;GET FREE STORAGE AT UUO LEVEL.
2314: 
2315: ↑UFSGET:
2316:         PUSHJ   P,FSGET                 ;GET FREE STORAGE AT UUO LEVEL
2317:         JRST    .+2                     ;FAILURE CANNOT HAPPEN (IT SAYS HERE)
2318:         POPJ    P,                      ;EXPECTED RETURN
2319:         PUSHACS                         ;STUFF EVERYTHING AWAY
2320:         PUSHJ   P,DISDATE
2321:         PUSHJ   P,DISMES
2322:         ASCIZ/π
2323: NO FREE STORAGE AT UFSGET. /
2324:         CONSO   PI,77400                ;ARE THERE ANY CHANNELS ACTIVE?
2325:         JRST    UFSGT1                  ;NO.
2326:         PUSHJ   P,DISMES
2327:         ASCIZ   /NOT AT UUO LEVEL!  RETURN PC = /
2328:         MOVE    TAC,P-17(P)
2329:         PUSHJ   P,DISOCT
2330:         PUSHJ   P,DISMES
2331:         ASCIZ   / PI = /
2332:         CONI    PI,TAC
2333:         PUSHJ   P,DISLOC
2334: UFSGT1: PUSHJ   P,DISCRLF
2335:         POPACS
2336:         JSP     DAT,UERROR              ;GIVE A UUO ERROR.
    CORE page# 0027 next  prev
2338: ; ROUTINES TO GET AND RELEASE THE PDL AT UUO LEVEL ONLY. - GETPDL
2339: ; CALLING:
2340: ;       JSP TAC,GETPDL                  ;TO GET A PDL
2341: ;       PUSHJ P,RELPDL                  ;TO RELEASE A PDL
2342: ; NOTE FREE STORAGE BLOCK THAT THIS PDL USES WILL BE PLACED
2343: ; ON THE FREE STORAGE RETURN LIST. THE BLOCK WILL ACTUALLY
2344: ; BE RETURNED THE NEXT TIME CHANNEL 7 IS ACTIVATED BY THE CLOCK.
2345: ; YOU MUST FINISH USING THE PDL AT UUO LEVEL OR CHANNEL 7 LEVEL,
2346: ; WHICHEVER YOU'RE PRESENTLY IN.
2347: 
2348: ; THE NUMBER IN J MUST BE THE CORRECT JOB NUMBER.
2349: ; AND PROG MUST POINT TO THE RIGHT JOB DATA AREA
2350: 
2351: ;GETPDL SHOULD BE A NO-OP AFTER SYSTEM 6.09L
2352: 
2353: ↑GETPDL:
2354:         SKIPE   P,JBTPDL(J)
2355:         JRST    (TAC)
2356:         MOVEM   BLOCK,JOBTM1(JDAT)      ;SAVE AC'S IN JOB DATA AREA
2357:         MOVEM   SIZE,JOBTM2(JDAT)
2358:         MOVEI   SIZE,JBTPLN             ;GET ONE THIS SIZE
2359:         MOVEI   P,JOBPDL-1(JDAT)        ;MAKE A TEMPORARY PDL FOR FSGET
2360:         HRLI    P,-JOBPLN               ;THIS LONG
2361:         PUSHJ   P,FSGET                 ;GET SOME FREE STORAGE
2362:         JSP     DAT,ERROR               ;IT CAN'T HAPPEN.
2363:         PSYNC   PDLCSC                  ;SYNCHRONIZE
2364:         SKIPN   P,JBTPDL(J)             ;HAS HE GOT ONE SOME OTHER WAY?
2365:         JRST    GETPD1                  ;NO. WE USE THE ONE WE JUST GOT
2366:         XSYNC   PDLCSC                  ;DESYNCHRONIZE
2367:         PUSHJ   P,FSGIVE                ;RETURN THE PDL WE DON'T NEED IT.
2368:         JRST    GETPD2                  ;AND RETURN IT.
2369: GETPD1: MOVEI   P,-1(BLOCK)             ;GET THE PDL BASE-1
2370:         HRLI    P,1-<JBTPLN+JOBPRT-JOBPFI>      ;AND THE PDL LENGTH
2371:         MOVEM   P,JBTPDL(J)             ;SAVE PDL POINTER
2372:         XSYNC   PDLCSC                  ;RELEASE INTERLOCK
2373:         SETZM   1(P)                    ;ZERO A CELL
2374:         MOVSI   BLOCK,1(P)              ;MAKE A BLT POINTER
2375:         HRRI    BLOCK,2(P)
2376:         BLT     BLOCK,JBTPLN(P)         ;ZERO THE ENTIRE PDL
2377: GETPD2: MOVE    BLOCK,JOBTM1(JDAT)      ;RESTORE THE AC'S WE SAVED
2378:         MOVE    SIZE,JOBTM2(JDAT)       
2379:         PUSHACS
2380:         PUSHJ   P,DISMES
2381:         ASCIZ   /AT GETPDL WITHOUT A PDL /
2382:         PUSHJ   P,DISJOB
2383:         PUSHJ   P,DISCRLF
2384:         POPACS
2385:         SKIPE   DEBMOD
2386:         PUSHJ   P,DDTCAL
2387:         JRST    (TAC)                   ;RETURN TO CALLER.
2388: 
2389: ↑RELPDL:
2390:         HRRZ    BLOCK,JBTPDL(J)         ;GET THE ADDRESS OF THE PDL
2391:         JUMPE   BLOCK,CPOPJ             ;NO PDL, CAN'T RELEASE
2392:         HRRZ    TAC,JBTPDL(J)           ;GET THE PDL ADDRESS
2393:         ADDI    TAC,JBTPLN+JOBPRT-JOBPFI        ;ADDRESS OF THE TOP IN TAC
2394:         SKIPN   (TAC)                   ;LOOK FOR A NON-ZERO CELL
2395:         SOJGE   TAC,.-1                 ;LOOP.
2396:         SUB     TAC,BLOCK               ;SUBTRACT THE BASE ADDRESS.
2397:         CAMLE   TAC,NPUSHD              ;BIGGER THAN OUR BIGGEST
2398:         MOVEM   TAC,NPUSHD              ;YES. SAVE THIS NUMBER
2399:         SETZM   JBTPDL(J)               ;CLEAR PDL CELL FOR NEXT JOB
2400:         AOS     NFSGIVES                ;COUNT THIS CELL HERE, SINCE FAKING IT
2401:         MOVNI   TAC,JBTPLN+2            ;GET THE SIZE OF THIS BLOCK
2402:         ADDM    TAC,FSBUSY              ;DECREASE BUSY COUNT TOO.
2403:         AOJA    BLOCK,FSQUIK            ;CHECK BLOCK, STUFF ON FSRTL, RETURN
    CORE page# 0028 next  prev
2405: ;SPARE LIST HANDLER FOR DPYSER & TTYSER
2406: 
2407: ;HERE WE SET UP THE INITIAL QUOTAS (QUOTAE?)
2408: SFSINI: HRRZ DDB,SFHEAD         ;THE SPARE LIST LIST
2409: SFSIOL: LDB DAT,[331000,,SFSIZE(DDB)]   ;HOW MANY DOES THIS ONE WANT?
2410:         JUMPE DAT,SFSI2         ;NONE?
2411:         HRRZ AC3,SFSIZE(DDB)
2412:         MOVEI AC2,(DDB)         ;INIT PNTR FOR LINKING
2413: SFSIIL: PUSHJ P,FSGETU
2414:         JRST .+4                ;LOSE - SET TO TRY LATER (SHOULDN'T HAPPEN)
2415:         MOVEM AC1,(AC2)         ;LINK IT IN
2416:         MOVEI AC2,(AC1)
2417:         SOJG DAT,SFSIIL
2418:         SETZM (AC2)             ;TERMINATE LIST
2419:         MOVEM DAT,SPFSN(DDB)    ;SET FROM DAT IN CASE WE LOST
2420:         SKIPL SFSIZE(DDB)
2421:         ADDM DAT,SPFSNT
2422: SFSI2:  HRRZ DDB,SFLINK(DDB)
2423:         JUMPN DDB,SFSIOL
2424:         POPJ P,
2425: 
2426: ;WE GET HERE AT CLOCK LEVEL WHEN SPFSNT>0 TO REPLENISH OUR SPARES
2427: ↑SFSCLK:HRRZ DDB,SFHEAD
2428: SFSCL1: SKIPLE SPFSN(DDB)       ;IF THIS LIST DOESN'T NEED ANY
2429:         SKIPGE SFSIZE(DDB)      ;OR THIS ISN'T THE CLOCK-FILLED KIND
2430:         JRST SFSCL2             ;TRY NEXT LIST
2431: SFSCLL: HRRZ AC3,SFSIZE(DDB)
2432:         PUSHJ P,FSGET           ;TRY TO GET ONE
2433:         JRST SFSCL2             ;LOSE - DON'T BOTHER WITH THIS LIST ANY MORE
2434:         CONO PI,PIOFF
2435:         EXCH AC1,(DDB)          ;PUT IT IN THE LIST
2436:         MOVEM AC1,@(DDB)
2437:         CONO PI,PION
2438:         SOS AC1,SPFSNT          ;DECREMENT TOTAL
2439:         SOSLE SPFSN(DDB)        ;& # THIS LIST
2440:         JRST SFSCLL             ;STILL NEED MORE
2441:         JUMPLE AC1,CPOPJ        ;THIS LIST ALL SET, ANY OTHERS TO DO?
2442: SFSCL2: HRRZ DDB,SFLINK(DDB)    ;YES, TRY NEXT LIST
2443:         JUMPN DDB,SFSCL1        ;IF THERE IS ONE
2444:         POPJ P,
    CORE page# 0029 next  prev
2446: ;VERSION OF FSGET TO USE SPARE LIST
2447: ;LIKE FSGET EXCEPT AC3 HAS SPARE LIST HEADER POINTER INSTEAD OF SIZE
2448: ;SIGN BIT (AC3) MEANS NO SKIP (OR FAILURE) RETURN
2449: ;SFNWT BIT FORCES FAILURE RETURN EVEN AT UUO LEVEL
2450: ↑SFSGET:PUSH P,AC3
2451:         SKIPGE SFSIZE(AC3)
2452:         JRST SFGSF              ;WANTS TO TRY SPARES FIRST
2453: SFGFS:  HRRZ AC3,SFSIZE(AC3)
2454:         PUSHJ P,FSGETU
2455:         JRST SFSGTS             ;NO FS, TRY SPARE
2456: SFSXIT: POP P,AC3
2457: SFSWIN: JUMPGE AC3,CPOPJ1       ;HERE WE HAVE WON, AND GIVE THE REQUESTED SUCCESS RETURN
2458:         POPJ P,
2459: 
2460: SFSGTS: PUSHJ P,SFGTS           ;TRY TO GET A SPARE
2461:         JRST SFSLUZ             ;OOPS - NO SPARE, EITHER
2462: SFSGOK: POP P,AC3
2463:         AOS SPFSN(AC3)          ;NOW WE NEED ANOTHER
2464:         SKIPL SFSIZE(AC3)       ;AND UNLESS WE'RE KEEPING SFSCLK OUT
2465:         AOS SPFSNT              ;WE SHOULD REQUEST SERVICE FROM IT
2466:         JRST SFSWIN
2467: 
2468: SFGSF:  PUSHJ P,SFGTS           ;HERE WE TRY THE SPARES FIRST
2469:         SKIPA AC3,(P)           ;LOSE - GET THE PNTR SO WE CAN GET THE SIZE FOR FSGET
2470:         JRST SFSGOK             ;WIN - UPDATE THINGS & EXIT
2471:         JRST SFGFS              ;NOW TRY FSGET
2472: 
2473: SFGTS:  MOVEI AC3,              ;PREPARE TO FLUSH LINK
2474:         CONO PI,PIOFF           ;GET SPARE FROM LIST AT @(P)
2475:         SKIPN AC1,@-1(P)
2476:         JRST PIONJ              ;NONE
2477:         EXCH AC3,(AC1)          ;THIS ZEROES LINK TO TELL RELEX SOMETHING CHANGED
2478:         MOVEM AC3,@-1(P)        ;DELINK IT FROM THE LIST
2479:         CONO PI,PION
2480:         JRST CPOPJ1
2481: 
2482: SFSLUZ: POP P,AC3
2483:         AOS SFLOSS(AC3)         ;COUNT OUR TOTAL LOSSES
2484:         CONSO PI,77400
2485:         JRST SFULUZ             ;UUO LEVEL - NOT TOO BAD
2486:         JUMPL AC3,SFILUZ        ;IF WE CAN'T GIVE A FAILURE RETURN WE ARE IN DEEP TROUBLE
2487:         POPJ P,                 ;WHEW!
2488: 
2489: SFULUZ: TLNE AC3,SFNWT          ;IF THE CALLER DOESN'T WANT TO WAIT
2490:         JUMPGE AC3,CPOPJ        ;AND HE ALLOWS FAILURE, JUST RETURN
2491:         PUSH P,AC3
2492:         HRRZ AC3,SFSIZE(AC3)
2493:         PUSHJ P,UFSGET          ;OTHERWISE OFF TO FSGET TO WAIT FOR IT
2494:         JRST SFSXIT
    CORE page# 0030 next  prev
2496: ;ARRRGH! PI LEVEL AND NO FAILURE POSSIBLE! HERE WE CURL UP AND DIE
2497: SFILUZ: HLRZ AC2,SFLOSS(AC3)    ;MAYBE THE CONDEMNED HAS A FEW LAST WORDS
2498:         SKIPN AC2
2499:         MOVEI AC2,[ASCIZ /SOMETHING/]   ;NOPE
2500:         PUSHACS
2501:         PUSHJ P,DISDAT
2502:         PUSHJ P,DISERR
2503:         [ASCIZ /πππππππNO CORE FOR /]
2504:         @AC2-20(P)
2505:         [ASCIZ / AT SFSGET.
2506: 
2507: /]
2508:         -1
2509:         CONO PI,PIOFF
2510:         SETOM DISFLAG
2511:         PUSHJ P,DISFLUSH
2512:         PUSHJ P,DDTCALL                 ;MAYBE SOMEONE WANTS TO KNOW WHY
2513:         JRST AUTOLOAD           ;AS THE SYSTEM SINKS SLOWLY INTO THE WEST
    CORE page# 0031 next  prev
2515: ;VERSION OF FSGIVE TO THINK ABOUT PUTTING RETURNED BLOCK INTO SPARE LIST
2516: ;LIKE FSGIVE BUT CALL IS FOLLOWED BY LIST HEADER ADDRESS
2517: ↑SFSGIV:PUSH P,AC3
2518:         AOS AC3,-1(P)           ;SKIP OVER ARG
2519:         MOVEI AC3,@-1(AC3)      ;& GET IT
2520:         SKIPGE SFSIZE(AC3)      ;ONLY RETURN INTO LIST IF THIS BIT IS ON
2521:         SKIPG SPFSN(AC3)        ;AND WE NEED SOME
2522:         JRST [POP P,AC3↔JRST FSGIVE]    ;OTHERWISE GIVE IT BACK TO FS
2523:         PUSH P,AC1
2524:         ANDI AC1,-1
2525:         CONO PI,PIOFF
2526:         EXCH AC1,(AC3)          ;LINK IT IN
2527:         MOVEM AC1,@(AC3)
2528:         CONO PI,PION
2529:         POP P,AC1
2530:         SOS SPFSN(AC3)          ;ONE FEWER NEEDED
2531:         POP P,AC3
2532:         POPJ P,
2533: 
2534: ;ROUTINE TO DYNAMICALLY SHRINK SIZE OF SPARE LIST
2535: ;CALL WITH -# TO DECREASE IN AC2, HEADER POINTER IN AC3 (CLOBBERS AC1 & AC2)
2536: ↑SFSREL:SKIPL SFSIZE(AC3)       ;AS USUAL, THIS TYPE LEAVES SPFSNT ALONE
2537:         ADDM AC2,SPFSNT
2538:         ADDB AC2,SPFSN(AC3)
2539:         JUMPGE AC2,CPOPJ        ;LEAVE IF WE DON'T HAVE TO GIVE ANY AWAY
2540: SFSRLL: CONO PI,PIOFF
2541:         SKIPN AC1,(AC3)         ;GET ONE
2542:         JRST PIONJ              ;NONE
2543:         HRRZ AC2,(AC1)
2544:         MOVEM AC2,(AC3)         ;LINK IT OUT
2545:         CONO PI,PION
2546:         PUSHJ P,FSGIVE          ;AND GIVE IT BACK TO THE WORLD
2547:         SKIPL SFSIZE(AC3)       ;THE UBIQUITOUS TEST (SIGH)
2548:         AOS SPFSNT
2549:         AOSGE SPFSN(AC3)        ;ONE MORE "NEEDED" (SHOULD BE GOING UP TO 0)
2550:         JRST SFSRLL             ;AND WE'LL KEEP AT IT UNTIL IT DOES
2551:         POPJ P,
    CORE page# 0032 next  prev
2553: ;YES FANS, IT'S THE INFAMOUS RELEX, FORMERLY SCATTERED THROUGH TTYSER & DPYSER
2554: ;THIS ONE TRIES TO SHUFFLE UP ALL THE SPARES IN THE BOTTOM 1K
2555: ;BY REPLACING THEM WITH NEW ONES FROM FREE STORAGE
2556: ;IT GIVES UP QUICKLY IF THE NEW ONES AREN'T ABOVE THE BOTTOM 1K
2557: RELEX:  MOVE AC2,MEMSIZ
2558:         ADDI AC2,2000           ;THIS WILL BE OUR THRESHOLD
2559:         CAML AC2,RMEMSIZ        ;BUT LEAVE THE TOP 1K ALONE
2560:         POPJ P,         ;IF THIS INSTRUCTION GETS EXECUTED SOMEONE DESERVES OUR WARMEST CONGRATULATIONS
2561:         HLRZ DDB,SFHEAD         ;THERE WAS ONCE A REASON FOR GOING THROUGH BACKWARDS
2562: RELX1:  MOVEI TAC,(DDB)         ;START THE "PREVIOUS" POINTER HERE
2563: RELX2:  HRRZ TEM,(TAC)          ;CONSIDER A BLOCK
2564:         JUMPE TEM,RELXO         ;GEE, WASN'T THAT EASY
2565:         CAIL TEM,(AC2)
2566:         JRST RELXI              ;HE'S NOT IN THE BOTTOM 1K, SO WE WON'T WORRY ABOUT HIM NOW
2567:         MOVE TAC1,(TEM)         ;PICK UP HIS LINK
2568:         HRRZ AC3,SFSIZE(DDB)    ;HE MUST BE THIS BIG
2569:         PUSHJ P,FSGET           ;GET A SHINY NEW PIECE
2570:         JRST RELXO              ;OH WELL, SO MUCH FOR THIS LIST
2571:         CAIGE AC1,(AC2)         ;SEE IF THE NEW ONE IS ABOVE THE BOTTOM 1K
2572:         JRST RELXL              ;TIME TO SEE THE COMPLAINT DEPARTMENT
2573:         MOVEM TAC1,(AC1)        ;COPY THE LINK
2574:         CONO PI,PIOFF           ;NOW CLOSE OUR EYES
2575:         CAMN TAC1,(TEM)         ;AND IF THESE 2 POINTERS
2576:         CAME TEM,(TAC)          ;STILL AGREE
2577:         JRST [CONO PI,PION↔JRST RELXL]  ;CURSES! FOILED AGAIN! GIVE BACK NEW BLOCK.
2578:         MOVEM AC1,(TAC)         ;QUICK! PULL THE SWITCH!
2579:         CONO PI,PION            ;DIDN'T SEE A THING
2580:         EXCH AC1,TEM            ;DON'T FORGET TO TELL FSGIVE ABOUT THE SWITCH
2581:         PUSHJ P,FSGIVE          ;NOW GET RID OF THE LOSER
2582: RELXI:  MOVE TAC,TEM            ;THIS IS NOW THE PREVIOUS BLOCK
2583:         JRST RELX2
2584: 
2585: RELXL:  PUSHJ P,FSGIVE          ;GIVE BACK THE NEW ONE
2586: RELXO:  HLRZ DDB,SFLINK(DDB)    ;AND TRY A NEW LIST
2587:         JUMPN DDB,RELX1         ;IF THERE'S ONE TO BE FOUND
2588:         POPJ P,
    CORE page# 0033 next  prev
2590: BEND CORE
 EOF: CORE end-of-file. cnt=32